TITLE	IMPCOM - IMP COMMAND HANDLER
	SUBTTL	SUNDBERG/RLS/HVZ/EAT/EW13/HVZ/DMB/drp -- 15 may 80
	; find all the symbols we might need.
	SEARCH	IMP,HstTbl,Tulip,MacTen,UUOSym	

	$TwoSeg
	$High

	ENTRY	IMPCOM
	VERSION 13,,102,1
; job data values we need
	EXTERN	.JBREL, .JBFF, .JbDDT, .JbSa, .JbUsy, .JbSym, .JbCor


; feature test switches for conditional compilation control
ifndef FtKSeg,<FtKSeg==0>	;drp	-1 if want to kill hiseg while
				;drp	 crosspatched.

;CONSTANTS

	PDLEN==100		;PUSHDOWN STACK LENGTH

;I/O CHANNELS

	;	0,1		RESERVED FOR UUO PACKAGE
;[tcp]	ICPCHN==2		;INITIAL CONNECTION PROTOCOL CHANNEL
	;	2,3		RESERVED FOR DATA TRANSFER PROTOCOL(AFTER ICP)
	ITLCHN==2		;TELNET CHANNEL (AFTER ICP)
	OTLCHN==3		;TELNET OUTPUT CHANNEL
	HLPCHN==4		;CHANNEL FOR READING HELP FILE
	TTYCHN==5		;CHANNEL FOR SETTING TTY STATUS BITS
	SUBTTL PARAMETER, SYMBOL, AND MACRO DEFINITIONS     

	A=	11	; three regs used for keeping important
	B=	12	; information from being destroyed by the
	C=	13	; tulip and impsub modules.
; flags used in the command parser.
; several of these flags are actually defined in Tulip.mac, but
; are "redefined" here for documentation purposes.
; do NOT try to second guess these flags: ALWAYS use the TX?? macro.

	FLAG	(LZEFLG)	;LEADING ZEROES NOT TO BE SUPPRESSED
	FLAG	(ODDFLG)	;FLAGS ODD (OUTPUT) SOCKET OPERATION
	HstCmd==OddFlg		; reuse: also indicates HOST command
	FLAG	(BRKFLG)	;A BREAK CHAR WAS SEEN
	FLAG	(RUNFLG)	;IMPCOM WAS CALLED WITH A RUN
	FLAG	(LOGFLG)	;JOB IS LOGGED IN
	FLAG	(LETFLG)	;AT LEAST ONE LETTER IN THE SYMBOL
	FLAG	(DEVFLG)	;DEVICE SPECIFIED
	FLAG	(HSTFLG)	;HOST 	"
	FLAG	(LCLFLG)	;LOCAL SOCKET
	FLAG	(RMTFLG)	;REMOTE SOCKET
	FLAG	(BYTFLG)	;BYTE SIZE
	FLAG	(JOBFLG)	;JOB NUMBER SPECIFIED
	FLAG	(STTFLG)	;STATE SPECIFIED
	FLAG	(USRFLG)	;A USER NUMBER WAS SPECIFIED
	FLAG	(WATFLG)	;A WAIT CODE WAS GIVEN
	FLAG	(IVLFLG)	;A TIME INTERVAL WAS GIVEN
	FLAG	(ALLFLG)	;AN ALLOCATION WAS SPECIFIED

COMFGS==DEVFLG!HSTFLG!LCLFLG!RMTFLG!BYTFLG!JOBFLG!STTFLG!HstCmd!ODDFLG!USRFLG!IVLFLG!ALLFLG

	FLAG	(ALLSWT)	;/ALL -- USE ALL PROGRAMMER NUMBERS
	FLAG	(SLFSWT)	;/SELF -- THIS JOB ONLY
	FLAG	(OUTSWT)	;/OUTPUT -- OUTPUT SIDE ONLY
	FLAG	(INPSWT)	;/INPUT -- INPUT SIDE ONLY
	FLAG	(LNGSWT)	;/LONG -- GIVES LONG FORM OF DATA
	FLAG	(GODSWT)	;/DEITY -- USER WANTS SPECIAL ACTION
	FLAG	(NWTSWT)	;/NOWAIT -- IGNORE WAIT TIME PARAMETERS
	FLAG	(FSTSWT)	;/FAST -- SHORT STATUS LISTING
	FLAG	(TTLSWT)	;/TITLE -- FORCE PRINTING OF TITLE
	FLAG	(SITSWT)	;/SITE:N SPECIFIED RATHER THAN /HOST:N
	FLAG	(ECHSWT)	;/ECHO -- LOCAL ECHOING
	FLAG	(NECSWT)	;/NOECHO -- REMOTE ECHOING
	FLAG	(LFSWT)		;/LF -- SEND LF AFTER CR
	FLAG	(NLFSWT)	;/NOLF -- DON'T SEND LF AFTER CR
	FLAG	(ABSSWT)	;/ABSOLUTE LOCAL SOCKET NUMBER SPECIFIED

COMSWS==ALLSWT!SLFSWT!OUTSWT!INPSWT!NWTSWT!SITSWT!ECHSWT!NECSWT!LFSWT!NLFSWT!ABSSWT

	Flag	(NckNam)	; have printed at least one nickname
	FLAG	(TITLTY)	;TITLE ALREADY TYPED
	FLAG	(DUPLEX)	;THIS IS A DUPLEX CONNECTION
	FLAG	(SEPARA)	;[96bit] seen the character separating
				;	 the site number from the host.

IfL $FlagN,<Printx	? Too many flags defined.>
;MACRO FOR DEFINING A NETWORK CONNECTION BLOCK

;[96bit] redefine to handle new UUO format
DEFINE	NET	(D, L, H, R, B<↑D8>)<
;;ARGUMENTS
;;	D	PDP-10 DEVICE NAME.  MAY BE LOGICAL OR PHYSICAL.
;;		IF LEFT BLANK A FREE IMP DEVICE WILL BE ASSIGNED.
;;	L	LOCAL (8 BIT) SOCKET NUMBER.  DEFAULT IS 0.
;;	H	REMOTE HOST NUMBER.  DEFAULT IS 0 (ILLEGAL).
;;	R	REMOTE SOCKET NUMBER.  DEFAULT IS 0.
;;	B	CONNECTION BYTE SIZE.  DEFAULT IS 8.
	SIXBIT	\D\
	EXP	-1
	EXP	L
	EXP	H
	EXP	R
	XWD	B,0
>
	; bits used in connection parameter word
	PW.NLF==1B0	;NO LINEFEED DESIRED AFTER CR
	PW.NEC==1B1	;NO ECHOING DESIRED

; what to do for a command error: print a message, and flush line,
; then quit.
Define	CmdErr(Msg)
    <
	EDisix	[Stop1A,,Msg]
    >

; what to do for a table lookup failure
Define	TabErr(Msg)
    <
	Jrst	[			; table error: remember why
		 Movei	T2,Msg		; load message
		 Jrst	TabDcd		; sort everything out
		]
    >

; move to column position.
; NOTE: it blows away T4.
Define	WTab (Pos)
    <
	Call	[Push	p,T1	; save a reg
		 movei	T1,Pos	; get the offset
		 PJrst	Tabit	; and go do the routine
		]
    >
	SUBTTL	COMMAND TABLES

;FLAGS IN LH OF COMMAND DISPATCH TABLE

	CM.LOG==1B0	;LOGIN NOT REQUIRED
	CM.AVL==1B1	;NETWORK NEED NOT BE AVAILABLE
	CM.MON==1B2	;IMP MONITOR NOT REQUIRED


	DEFINE	COMS <

	CC	CLOSE
	CC	CONNECT
	CC	DEASSIGN,<AVL>
	CC	ERROR,<AVL>
	CC	HELP,<LOG,AVL,MON>
	CC	HOST,<LOG,AVL,MON>
	CC	LISTEN,<AVL>
	CC	NCPDWN,<AVL>
	CC	NCPINI,<AVL>
	CC	NCPUP,<AVL>
	CC	NEWS
	CC	RESET
	CC	Request		; do a listen and wait for reply
	CC	STATUS,<LOG,AVL>
	CC	TALK
	CC	TELNET
	CC	Tn		; another equivalent

>

;SPECIAL ADDITIONAL HELP TEXTS AVAILABLE

	DEFINE	HELPS <

	CC	CONTROL
	CC	ECHO
	CC	ESCAPE
	CC	SAMPLE
	CC	SHIFT
	CC	SOCKET
	CC	STATE
	CC	SWITCH
	CC	SYNTAX

>
;COMMAND NAME TABLE

COMLST:	-COMLEN,,COMNAM		;POINTER TO COMMAND LIST

	DEFINE	CC(C,F) <
	<SIXBIT	\C\>
>

COMNAM:	COMS

	COMLEN==.-COMNAM	;LENGTH OF COMMAND LIST
;COMMAND DISPATCH TABLE

	DEFINE	CC(C,F) <
	ZZ==	0
IFNB <F>,<IRP F<
	ZZ==	ZZ!CM.'F
>>
	ZZ + I.'C
>

COMDSP:	COMS
	SUBTTL INITIALIZATION AND COMMAND DECODING

IMPCOM:	JFCL			;IGNORE CCL ENTRY
	TDZA	F,F		;CLEAR FLAGS
IMPCO1:	MOVEI	F,RUNFLG	;SIGNAL RUN COMMAND OR UUO
	MOVE	P,[IOWD PDLEN,PDL]
	Save	F		; don't let it clear the flags
	Start			; but reinitialize tulip
	Restore	F		; get it back.
	Move	T1,[Call FScan]		; change tty to use FSCAN
	Movem	T1,TTiBlk## + FilXct	; for input
	Move	T1,[Call CntOut]	; and use CntOut
	Movem	T1,TToBlk## + FilXct	; for output
	MOVE	T1,[ZERO,,ZERO+1]
	SETZM	ZERO
	BLT	T1,ZEREND
	MOVE	T1,[FILLHI,,FILL]
	BLT	T1,FILEND
	FSetUp	FilHlp		; set up the help lowseg block
	GETPPN	T1,		;GET PROJ,PROG
	  JFCL			;(GETPPN SKIPS IF JACCT)
	MOVEM	T1,PRJPRG
	PJOB	T1,		;JOB NUMBER
	MOVEM	T1,JOBN
	movn	T2,T1		; negative job number
	JobSts	T2,		; get job status
	  SETZ	T2,		;NO STATUS BITS
	TXNE	T2,Jb.Uli	;JOB LOGGED IN?
	TXO	F,LOGFLG	;YES, REMEMBER SO
	LHOST	HSTBLK		;RETURN LOCAL HOST NUMBER
	  SETZM	THSITE		;MUST BE NON-IMP MONITOR
;[96bit]LDB	T1,[POINT 9,THSITE,17] ;GET NUMBER OF IMPS IN THIS SYSTEM
	LDB	T1,[POINT 9,.IbDev + HstBlk,17]	;[96bit] # of imps
	MOVEM	T1,IMPNUM	;SAVE FOR LATER
	VERS	SYSVER		;RETURN IMP SYSTEM SOFTWARE VERSIONS
	  SETZM	SYSVER		;HOW CAN THIS BE?
	MOVSI	T3,'HLP'		;ASSUME HELP FILE ON HLP:
	SKIPE	.JBDDT		;UNLESS DEBUGGING
	MOVSI	T3,'DSK'
	HRROI	T1,.GTSGN	;GET HI-SEG NUMBER FOR THIS JOB
	GETTAB	T1,
	  SETZ	T1,		;NO HI-SEG??
	JUMPLE	T1,IMPC1A	;JUMP IF NOT USING A HI-SEG
	MOVSI	T2,(T1)		;GET DIRECTORY HI-SEG WAS INITED FROM
	HRRI	T2,.GTPPN
	GETTAB	T2,
	  SETZ	T2,		;OBSOLETE OR SOMETHING, ASSUME SYS.
	tlnn	t2,-1		; is this a monitor SFD pointer?
	  setz	t2,		; yes.  forget it.
	JUMPE	T2,IMPC1A	;JUMP IF NONE
	MOVSI	T3,(T1)		;GET HI-SEG DEVICE
	HRRI	T3,.GTDEV
	GETTAB	T3,
	  SKIPGE T3,T2		;LEVEL C--DEVICE IS IN PPN IF NEGATIVE
	JRST	.+2		;LEVEL D, OR LEVEL C NON-DISK
	MOVSI	T3,'DSK'		;LEVEL C DISK
IMPC1A:	MOVEM	T3,HLPFIL+FILDEV	;STORE HISEG DEVICE NAME
	MOVEM	T2,HLPFIL+FILPPN	;STORE HISEG DIRECTORY
ifn FtKSeg,<	;drp	may need this to get hiseg back
	MOVEM	T3,RUNDEV		;STORE ALSO IN GETSEG ARGLIST
	MOVEM	T2,RUNPPN		;STORE ALSO IN GETSEG ARGLIST
> ;drp	end of ifn FtKSeg
	INIT	TTYCHN,0	;GRAB TTY SO WE CAN DIDDLE STATUS BITS
	  SIXBIT \TTY\
	  0
	  IDIOT			;TTY NOT AVAILABLE
	Hrlzi	T1,ComNd	; assume a need to parse "Imp <command>"
	TXNE	F,RUNFLG	;IS IT?
	JRST	IMPCO2		;NO, GO PROMPT FOR INPUT
	RESCAN	1		;MAYBE, RESCAN INPUT LINE
	 SKPINL			;MIGHT BE SOMETHING THERE.  IS THERE?
	  TXOA	F,RUNFLG	;NO, PROMPT FOR INPUT
	   JRST	IMPCO3		;YES, GO PROCESS "IMP" COMMAND
IMPCO2:	WCHI	"*"		;PROMPT FOR INPUT
	Hrlzi	T1,ComNm	; enter the productions at this point
IMPCO3:	CALL	TEXTIN		;GET COMMAND INTO A
	TXNE	F,BRKFLG	;END OF LINE?
	JUMPE	A,IMPCO5	;YES, JUMP IF NO COMMAND
	MOVE	T2,COMLST	;COMMAND TABLE
;[96bit]CALL	SIXSRC		;SEARCH IT
;[96bit]  CMDERR CMDERM
	Call	SixSrA		; search table for what's in A
	  TABERR [Sixbit \&COMMAND!\]	;[96bit] tell why not found
	MOVE	T1,COMDSP(T1)	;FOUND IT--GET DISPATCH ENTRY
	TXNN	T1,CM.LOG	;LOGIN REQUIRED?
	TXNE	F,LOGFLG	;YES, JOB LOGGED IN?
	CAIA			;YES OR NOT REQUIRED
	CMDERR	[SIXBIT\?L&OGIN PLEASE#!\]
	lhost	hstblk		;drp	get latest local stats.
	  setzm	thsite		;drp	mark this as a failure.
	TXNN	T1,CM.AVL	;NETWORK AVAILABILITY REQUIRED?
;[96bit]SKIPL	THSITE		;YES, IT IT?
	SKIPL	.IbStt + HstBlk	; yes.  is it available?
	CAIA			;YES OR NOT REQUIRED
	CMDERR	[SIXBIT\?N&ETWORK NOT AVAILABLE#!\]
	TXNN	T1,CM.MON	;IMP MONITOR REQUIRED?
	SKIPE	THSITE		;YES, IS IT?
	JRST	(T1)		;YES OR NOT REQUIRED, DISPATCH
	CMDERR	[SIXBIT\?N&ON-&IMP& MONITOR RUNNING#!\]

;HERE ON BLANK COMMAND (I.E. JUST <CR> OR "IMP<CR>")
IMPCO5:
	MOVEI	T2,CtrlZ	;[96bit] was the last
	CAMN	T2,TTiBlk## + FilCur	;[96bit] character a control Z?
	  EXIT			;[96bit] yep: exit
	TXNE	F,LOGFLG	;JOB LOGGED IN?
	JRST	IMPCO1		;YES, GO TO CUSP LEVEL
	CMDERR	[SIXBIT\?L&OGIN PLEASE#!\] ;NO, DON'T ALLOW CUSP LEVEL
;BRING THE SYSTEM UP AND DOWN
I.NCPU:	NCPUP	COMBLK		;COMBLK NEEDED FOR ADDRESS CHECKING
	  IMPERR
	JRST	STOP

I.NCPD:	PUSHJ	P,RUSURE	;GET CONFIRMATION
	  JRST	STOP		;NO
	NCPDWN	COMBLK		;COMBLK ADDRESS NEEDED FOR ADDRESS CHECK
	  IMPERR
	JRST	STOP


;COMPLETELY REINITIALIZE THE IMP SYSTEM
I.NCPI:	PUSHJ	P,RUSURE	;GET CONFIRMATION
	  JRST	STOP		;SECOND THOUGHTS
	NCPINI	COMBLK		;DO IT
	  IMPERR		;BOOBOO
	JRST	STOP


;RESET A SPECIFIED HOST (PRIVILEGED)
I.RESE:	TXNE	F,BRKFLG	;ERROR IF BLANK LINE
	CMDERR	ARGERM
	PUSHJ	P,SETME		;SET DEFAULTS
	PUSHJ	P,LISTIN	;SCAN ARGUMENT (HOST NAME)
	TXNE	F,<COMSWS+COMFGS-HSTFLG> ;SEE WHAT WE GOT
	JRST	A.ECMD		;TOO MUCH
	PUSHJ	P,RUSURE	;OK, REQUEST CONFIRMATION
	  JRST	STOP
	NCPRST	COMBLK		;RESET THE HOST
	  IMPERR
	JRST	STOP


;ROUTINE TO REQUEST CONFIRMATION OF CATASTROPHIC FUNCTIONS
;	PUSHJ	P,RUSURE
;	  COMMAND NOT CONFIRMED
;	COMMAND CONFIRMED

RUSURE:	CLRBFI			;CLEAR TYPEAHEAD
	TXZ	F,BRKFLG	;FLAG EMPTY LINE
	WSIX	[SIXBIT\A&RE YOU SURE? !\]
	Rchf	P2		;GET FIRST CHARACTER OF RESPONSE
	CAIE	P2,"Y"		;WAS IT YES?
	CAIN	P2,"Y"+40
	  Aos	(P)		; yes: set skip return
	PJrst	Flush		; flush the rest of the line and return
;CLOSE COMMAND
I.CLOS:	MOVEI	P1,STTBLK	;DO WORK HERE
	TXNE	F,BRKFLG	;EMPTY LINE?
	CMDERR	ARGERM		;YES
	SETZ	P2,
CLOS1:	CALL	SETME		;INIT DEFAULTS
	CALL	FIELDN		;GET SOME SPECS
	MOVEI	A,CLOS2		;SUBROUTINE
	CALL	ALLIMP		; TO EXECUTE FOR ALL IMPS
	TXZ	F,<COMSWS!COMFGS>
	TXNE	F,BRKFLG	;BREAK?
	JRST	TSTOP		;YES, DONE
	JRST	CLOS1

CLOS2:	TXNN	F,<GODSWT!DEVFLG> ;UNLESS EXPLICIT DEVICE OR /DEITY
	ITTY	(P1)		;CHECK FOR JOB CONTROL
	  JRST	.+3		;NO
	SKIPGE	1(P1)		;MAYBE, CHECK BITS
	POPJ	P,		;IMP CONTROLS JOB, DON'T TRY TO CLOSE IT
	MOVEM	A,(P1)		;SAVE PHYSICAL NAME IN CASE OF GODSWT ON
	CLOS	(P1)		;CLOSE THE SOCKET
	  IMPERR		;ERROR
	CLOS	1,.IBDEV(P1)	;NOW FORCE, JUST IN CASE
	  JFCL			;AND IGNORE ANY ERRORS
	AOJA	P2,Cpopj##	;COUNT IT

;DEASSIGN THE IMP DEVICE (SAFER THAN MONITOR CONSOLE COMMAND)
I.DEAS:	MOVEI	P1,STTBLK
	TXNE	F,BRKFLG
	CMDERR	ARGERM		;EXPLICIT ARGUMENT NEEDED
	SETZ	P2,
DEAS1:	CALL	SETME		;DEFAULTS
	CALL	FIELDN		;GET DEVICE SPEC
	MOVEI	A,DEAS2
	CALL	ALLIMP
	TXZ	F,<COMSWS!COMFGS>
	TXNE	F,BRKFLG	;DONE?
	JRST	TSTOP		;YES
	JRST	DEAS1

;SUBROUTINE TO DEASSIGN AN IMP DEVICE
DEAS2:	DEAS	(P1)
	  IMPERR
	AOJA	P2,Cpopj##
;LISTEN COMMAND
I.LIST:	MOVEI	P1,STTBLK
	SETZ	P2,
	CALL	SETME		;DEFAULTS
	TXNN	F,BRKFLG	;DONT SCAN IF NOTHING THERE
	CALL	LISTIN		;GET COMMAND
	TXNN	F,LCLFLG	;LOCAL SOCKET GIVEN?
NoLcl:	 CmdErr	[Sixbit \? L&ocal socket must be specified.#!\]
	MOVEI	A,LIST3		;ACTION SUBROUTINE
	CALL	ALLIMP		;DO FOR ALL IMP DEVICES
	JUMPG	P2,STOP		;DONE IF FOUND ANYTHING
	Listen	COMBLK		;GET A NEW ONE
	  IMPERR
	JRST	STOP

;THE LISTEN SUBROUTINE.  CALLED FOR EACH SPECIFIED IMP
LIST3:	Listen	STTBLK		;DO THE LISTEN
	  IMPERR
	AOJA	P2,Cpopj##	;COUNT IT AND EXIT


;Request COMMAND
I.Requ:	MOVEI	P1,STTBLK
	SETZ	P2,
	CALL	SETME		;DEFAULTS
	TXNN	F,BRKFLG	;DONT SCAN IF NOTHING THERE
	CALL	LISTIN		;GET COMMAND
	TXNN	F,LCLFLG	;LOCAL SOCKET GIVEN?
	  Jrst	NoLcl		; go complain
	MOVEI	A,Requ3		;ACTION SUBROUTINE
	CALL	ALLIMP		;DO FOR ALL IMP DEVICES
	JUMPG	P2,STOP		;DONE IF FOUND ANYTHING
	Request	COMBLK		;GET A NEW ONE
	  IMPERR
	JRST	STOP

;THE Request SUBROUTINE.  CALLED FOR EACH SPECIFIED IMP
Requ3:	Request	STTBLK		;DO THE Request
	  IMPERR
	AOJA	P2,Cpopj##	;COUNT IT AND EXIT
;CONNECT COMMAND
I.CONN:	MOVEI	P1,STTBLK
	SETZ	P2,
	CALL	SETME		;SET DEFAULTS
	TXNN	F,BRKFLG
	CALL	LISTIN		;GET COMMAND
	MOVEI	A,CONN4
	CALL	ALLIMP
	JUMPG	P2,STOP		;DONE IF FOUND ONE
	TXNN	F,LCLFLG	;LOCAL SOCKET GIVEN?
	  Jrst	NoLcl		; need a local socket.
	CONN	COMBLK		;CONNECT
	  IMPERR
	JRST	STOP		;YES

;SUBROUTINE TO CALL FOR EACH IMP
CONN4:	CONN	(P1)		;ATTEMPT TO CONNECT
	  IMPERR
	AOJA	P2,Cpopj##	;COUNT IT AND RETURN
;STATUS COMMAND.   RETURNS STATUS OF SELECTED SOCKETS OR
;  DEVICES.
I.STAT:	MOVEI	P1,STTBLK	;STATUS CONNECTION BLOCK
	STAT	(P1)		;JUST SEEIF IT WORKS
	  SKIPLE .IBSTT(P1)	;SKIP IF NOT AVAILABLE
	TDZA	P2,P2		;CLEAR COUNTER
	IMPERR	STOP		;ERROR MESSAGE AND OUT
	MOVEI	P3,XSTBLK	;BLOCK FOR READING EXTENDED STATUS
STAT1:	CALL	SETME		;INITIALIZE DEFAULTS
	TXNN	F,BRKFLG	;EMPTY LINE?
	CALL	FIELDN		;GET NEXT FIELD
	MOVEI	A,STAT3		;THE TYPEOUT ROUTINE
	CALL	ALLIMP		;TEST ALL IMPS
	TXNE	F,BRKFLG
	JRST	STOP
	TXZ	F,<COMSWS!COMFGS>
	JRST	STAT1
;SUBROUTINE TO TYPE THE STATUS OF SPECIFIC IMP DEVICES
STAT3:	hrrz	T2,.IBSTT+STTBLK	; get state
	TXNN	F,<INPSWT!OUTSWT!SLFSWT!DEVFLG!STTFLG>	; HVZ-4/23/75
	JUMPE	T2,STAT9		;DONT TYPE CLOSED SOCKETS
	MOVEM	A,.XSDEV(P3)	;STORE DEVICE NAME
	MOVEI	T2,.XSSIZ-1	;SET NUMBER OF ITEMS WANTED
	MOVEM	T2,.XSNUM(P3)
	XSTAT	(P3)		;READ EXTENDED STATUS
	  TXZ	F,LNGSWT	;ERROR, NOTE THAT WE CAN'T DO LONG STATUS
STAT3B:	PUSHJ	P,TYPSTS	;TYPE STATUS OF IMP
	TXNN	F,LNGSWT	;/LONG?
	  AOJA	P2,Cpopj##	;NO, FINISHED

;DO LONG STATUS
	WDEC	↑D9,.XSPrt(P3)	; protocol
	WDEC	↑D11,.XSRWn(P3)	; receive window
	WDEC	↑D11,.XSSWn(P3)	; send window
	wdec	↑d11,.xsRTT(p3)	; retransmission timeout time

STAT8:	W2CHI	CRLF
STAT9:	AOJA	P2,Cpopj##
;HOST COMMAND.  GIVES INFORMATION ABOUT ONE OR MORE SPECIFIED
;  HOSTS.
I.HOST:	Txo	F,HstCmd	; now in a host command
	TXNN	F,BRKFLG	;NULL ARGUMENTS TO COMMAND?
	JRST	HOST1		;NO
	TXO	F,ALLSWT	;YES, FORCE /ALL
	JRST	HOST4
HOST1:	CALL	FIELDN		;GET NEXT FIELD
	TXNE	F,<SITSWT!ALLSWT!HSTFLG> ;SOME HOST OR /ALL GIVEN?
	TXNE	F,<<COMSWS!COMFGS>-<SITSWT!ALLSWT!HSTFLG!HstCmd>> ;NO OTHERS?
;[96bit]JRST	A.ECMD		;TOO LITTLE OR TOO MUCH
	  JRST	A.SWBD		;[96bit] a switch that wasn't right
HOST4:	Movei	T2,GotHst	; where to go when we find a host
	Movei	T3,GotNck	; where to go for each nickname
	Txnn	F,AllSwt	; /all?
	  jrst	Host4a		; no: jump on.
	Txo	F,TtlSwt	; force a title
	Movei	T1,[0]		; set up to scan all the table
	Jrst	Host4b		; and go match with everyone
Host4a:	Txne	F,SitSwt	; site number?
	  Jrst	HstSit		; yes: go with site number
	Txnn	F,LetFlg	; and letters seen?
	  Jrst	HstNmb		; no: hope we found a number.
	Movei	T1,AscBuf	; point to the host string
Host4b:	Call	HstGen##	; go do it
	  Jrst	NoHTbl		; tables are not available
	  Jrst	NotThr		; host not in tables
	Jrst	HstEnd		; and rejoin ending code

; looking for a particular site, by number
HstNmb:	Skipa	T4,[Ih.Net!Ih.Hst!Ih.Imp]	; mask for exact match
; looking for all the hosts at a single site.
HstSit:	Movx	T4,Ih.Imp		; set site mask
	Move	T1,.IbHst+ComBlk	; get host number
	Call	HstNGn##		; find the numbers
	  Jrst	NoHTbl			; no host tables
	  Jrst	NotThn			; no such site
HstEnd:	Call	NckCln		; clean up leftover nickname and <crlf>
	TXZ	F,<COMSWS!COMFGS>	; HVZ-4/23/75
	TXNE	F,BRKFLG	;DONE?
	JRST	STOP		;YES
	JRST	I.HOST

NoHTbl:	CmdErr	[Sixbit \? H&ost tables cannot be accessed.#!\]
NotThr:	EDisix	[Stop1A,,[Sixbit \? N&o hosts match ""%"".#!\]
		 Wasc	AscBuf
		]
NotThn:	Move	T1,.IbHst+ComBlk	; retrieve host number
	EDisix	[Stop1A,,[Sixbit \? N&o hosts match %.#!\]
		 Call	TypHNm		; print the host number
		]
; here when we got a new host.
GotHst:	TXON	F,TITLTY	;TITLE ALREADY TYPED?
	Txzn	F,TTLSWT	;NO, WANT TITLE?
	JRST	HOST5		;NO OR ALREADY TYPED
	WSix	[Sixbit\#N&umber     &N&ame             &S&tatus$&N&icknames#!\]
;TYPE A HOST
HOST5:	Call	NckCln		; check for close nicknames. new line.
	Clearm	ChrCnt		; make believe in first column
	Andi	T3,ht$Sts	; mask all but the server status
	push	p,t1			;[tcp] save ascii name
	move	T1,T2		; get host number in place
	Call	TypHNm		; type site number
	pop	p,t2			;[tcp] restore ascii name
	Wtab	↑d11		; to next tab stop
	WAsc	(T2)		; type ascii name
	Wtab	↑d28		; find a tab stop
	WAsc	@[[Asciz \(None)\]	; ? not defined
		 [Asciz \Server\]
		 [Asciz \User\]
		 [Asciz \Tip\]
		](T3)			; type status
	Return				; and return

GotNck:	Txoe	F,NckNam	; is this the first nickname?
	  Disix	[Host6a,,[Sixbit \, !\]]	; no: separate
	WTab	↑d9		; go to a good column
				; (in HOST, we're past it already)
	W2Chi	"	("	; and then tab to place
Host6a:	Wasc	(T1)		; print this nickname
	Return			; and go back to HstGen

NckCln:	Txze	F,NckNam	; no nicknames printed for him yet
	  Wchi	")"		; but there was at least one for last
TCrLf:	W2Chi	CrLf		; output a crlf
	Return			; and return
;NEWS COMMAND.  DOES THE EQUIVALENT OF
;	TELNET BBN-TENEX /REMOTE:#367
;   TO ACCESS THE NETWORK NEWS SERVICE

I.NEWS:	MOVEI	P1,TELBLK	;TELNET CONNECTION BLOCK
	CALL	SETME		;SETUP COMMAND DEFAULTS
	MOVEI	T1,367		;PRESET REMOTE SOCKET
	MOVEM	T1,.IBRMT+COMBLK
;[96bit]MOVEI	T1,↑D241		;PRESET REMOTE HOST -- HVZ-4/23/75
;[96bit]HRRM	T1,.IBHST+COMBLK
	movei	T1,600061		;[96bit] preset host.
	MOVEM	T1,.IBHST+COMBLK	;[96bit]
	TXO	F,<HSTFLG!RMTFLG>	;PRETEND THESE ARGS TYPED
	JRST	TELN0A		;DO NORMAL TELNET PROCESSING


;TELNET COMMAND.  GENERATES OR CONNECTS TO A PREVIOUSLY
;  GENERATED CONNECTION.

I.Tn:
I.TALK:
I.TELN:	MOVEI	P1,TELBLK
	CALL	SETME		;SET DEFAULTS
TELN0A:	TXNN	F,BRKFLG
	CALL	LISTIN		;SCAN WHOLE LINE
	TXNE	F,<INPSWT!OUTSWT>
;[96bit]JRST	A.ECMD		;TOO MUCH!
	  JRST	A.SWBD		;[96bit] none are legal.
	SETZB	P2,P3		;CLEAR COUNTER
	JSP	A,TELNE0	;SET SUBROUTINE ADDRESS

	LDB	T2,[POINT 6,.IBSTT+STTBLK,35]
	JUMPE	T2,Cpopj##		;IGNORE CLOSED SOCKETS
	Move	T1,A		; get device
	TXNE	F,DEVFLG	;UNLESS EXPLICIT DEVICE TYPED,
	JRST	TELN0B		;  SKIP SPECIAL CHECKS
	HLRZ	T2,.IBDEV+STTBLK	;FTP MAKES LOGICAL NAME BE JOB # IN RIGHT,
	CAIN	T2,'FTP'		;  AND FTP IN LEFT
	POPJ	P,		;WHICH WE NORMALLY WON'T WANT TO CONNECT TO
	ITTY	T1		;CHECK FOR JOB CONTROL
	  JRST	.+2		;NO
	JUMPL	T2,Cpopj##	;YES, SKIP THIS IMP IF IT CONTROL A JOB
TELN0B:
;[tcp]	TXNN	F,ODDFLG	;WHICH SIDE?
;[tcp]	SKIPA	P3,T1		;INPUT, JUST REMEMBER NAME
;[tcp]	CAME	P3,T1		;OUTPUT--DID INPUT SIDE MATCH TOO?
;[tcp]	POPJ	P,		;NO--NOT A DUPLEX SOCKET (YET)
	move	p3,t1		;[tcp]
	MOVE	P4,P3		;YES, REMEMBER DEVICE NAME
	AOJA	P2,Cpopj##	;COUNT IT

TELNE0:	CALL	ALLIMP		;EXECUTE FOR ALL IMP DEVICES
;HERE AFTER CHECKING ALL MATCHING IMPS
	JUMPE	P2,TELNE1	;JUMP IF NO MATCH
	SOJG	P2,TELNE9	;ERROR IF MORE THAN ONE DUPLEX DEVICE
	MOVEM	P4,.IBDEV(P1)	;REMEMBER PHYSICAL NAME
	MOVEM	P4,.IBDEV+.IBSIZ(P1)
	SETZM	.IBLCL(P1)	;CHECK THE INPUT SIDE
	STAT	(P1)
	  IMPERR STOP
	LDB	T1,[POINT 6,.IBSTT(P1),35]
	JUMPE	T1,TELNE1	;USE IT IF NOT CLOSED, OTHERWISE TRY TO SET UP
;[96bit]HRRZ	T1,.IBHST(P1)	;GET HOST
	MOVE	T1,.IBHST(P1)	;[96bit] GET HOST
	Disix	[[SIXBIT \%: R&ECONNECTED TO !\]
		WNAME	.IBDEV(P1)
		]
	Call	TypHst			; go print the host
	Jrst	TelNe4			; go away
;CHECK OUT THE PARAMETERS
TELNE1:	TXNN	F,DEVFLG	;DEVICE GIVEN?
	JRST	TELN1A		;NO
	MOVS	T1,.IBDEV+COMBLK	;YES, GET COMMAND DEVICE
	CAIN	T1,'ICP'
	EDisix	[SPECER,,[SIXBIT \? D&EVICE!\]]
	MOVSM	T1,.IBDEV(P1)	;USE IT
	MOVSM	T1,.IBDEV+STTBLK
	JRST	TELNE6
TELN1A:	MOVE	T1,.IBDEV(P1)	;GET DEFAULT DEVICE NAME (TELNET:)
	DEVCHR	T1,		;DO WE ALREADY HAVE A TELNET:?
	TXNN	T1,DV.AVL
	JRST	TELNE6		;NO, USE LOGICAL NAME TELNET:
	SETZM	.IBDEV+STTBLK	;YES, DON'T USE ANY LOGICAL NAME
	SETZM	.IBDEV(P1)
TELNE6:
	TXNN	F,LCLFLG	;LOCAL SOCKET GIVEN?
	JRST	GTFRSK		;NO, GO FIND A FREE SOCKET NUMBER
;[tcp]	MOVE	T1,.IBLCL+COMBLK	;LOCAL SOCKET
;[tcp]	ANDI	T1,↑O777		;JUST 9 BITS
;[tcp]	CAIL	T1,2		;TOO SMALL?
;[tcp]	TRNE	T1,1		;NO, ODD?
;[tcp]	EDisix	[SKTER,,[SIXBIT \? L&OCAL !\]]
	JRST	TELNE5
GTFRSK:	SETCM	T1,FRESKT	;GET HIGH WORD OF SOCKET NUMBER USE MAP
	JFFO	T1,GTFRS1	;ANY FREE SOCKET BLOCKS?
	SETCM	T1,FRESKT+1	;NO, TRY LOW WORD
	JFFO	T1,.+2
	IDIOT			;ALL 64 SOCKET BLOCKS IN USE?????!!!!!
	ADDI	T2,↑D36		;OFFSET BECAUSE USING LOW WORD
GTFRS1:	LSH	T2,2		;CONVERT TO FIRST SOCKET # IN BLOCK
	MOVEI	T1,2(T2)		;LEAVE ROOM FOR ICP SOCKET
TELNE5:	MOVEM	T1,.IBLCL(P1)
	MOVE	T1,.IBHST+COMBLK
	TXNE	F,HSTFLG	;HOST
;[96bit]HRRM	T1,.IBHST(P1)
	MOVEM	T1,.IBHST(P1)	;[96bit]
;[tcp]	TXNN	F,BYTFLG	;BYTE SIZE
;[tcp]	JRST	TELNE2
;[96bit]HLRZS	T1
;[tcp]	HLRZ	T1,.IbByt+ComBlk	;[96bit]
;[tcp]	CAIE	T1,↑D8		;ONLY 8 IS LEGAL
;[tcp]	  EDisix	[SPECER,,[SIXBIT \? B&YTE SIZE!\]]
TELNE2:	TXNN	F,RMTFLG
	JRST	TELNE3
	skipa	t1,.ibrmt+ComBlk	;[tcp]
;[tcp]	MOVE	T1,.IBRMT+COMBLK
;[tcp]	TROA	T1,1		;MUST BE ODD
TELNE3:	MOVEI	T1,27	;SOCKET 23(27 octal) is now default TELNET ICP SOCKET
	movem	t1,.ibrmt(p1)		; save in the connection block
	CALL	ICPGET
	  JRST	STOP
;HERE WHEN A CONNECTION HAS BEEN SET UP
;[96bit]HRRZ	T1,.IBHST(P1)
	MOVE	T1,.IBHST(P1)	;[96bit]
	EDisix	[[SIXBIT \%: C&ONNECTED TO !\]
		WNAME	.IBDEV(P1)
		]
	Call	TypHst			; type out the host name
TELNE4:	MOVE	P2,[POINT 7,THSHST] ; setup for ascii local host name
	MOVEI	T2,[
		    PUSHJ P,[
			     Came P2,[Point 7,LstHst,27]  ; any room?
			       IDPB U1,P2		  ; yes.
			     POPJ P,
			    ]
		   ]
	Movem	T2,OFile##		;OUTPUT PSEUDO-FILE
;[96bit]HRRZ	T1,THSITE	;GET LOCAL HOST NUMBER
	MOVE	T1,THSITE	;[96bit] GET LOCAL HOST NUMBER
	PUSHJ	P,TYPHSN	;CONVERT AND STORE LOCAL HOST NAME
	WCHI	Null		;TERMINATE PROPERLY
	SETZM	OFile##		;RESTORE NORMAL TTY OUTPUT
	MOVE	T2,(P1)		;READ CONNECTION PARAMETER WORD FROM DDB
	RCPAR	T2
	  SETZ	T3,		;UNLIKELY ERROR -- ASSUME STANDARD SETTINGS
	TXNE	F,LFSWT		;/LF?
	TXZ	T3,PW.NLF	;YES, CLEAR NO-LINEFEED FLAG
	TXNE	F,NLFSWT	;/NOLF?
	TXO	T3,PW.NLF	;YES, SET NO-LINEFEED FLAG
	TXNN	T3,PW.NLF	;WANT LINE FEED SUPPRESSED?
	JRST	TELN4		;NOPE, DON'T BOTHER WITH UUOING
	SETO	T1,		;FETCH CURRENT LINE CHARACTERISTICS
	GETLCH	T1
	TXO	T1,GL.PTM	;YES, SET PAPER-TAPE MODE BIT
	SETLCH	T1		;SET LINE CHARACTERISTICS IN CASE CHANGED
TELN4:	PUSHJ	P,ECHCHK	;YES, SEND APPROPRIATE CODE TO SERVER
	RESC	ESCBLK		;READ THE CURRENT ESCAPES AND QUOTES
	  IMPERR TELN4A		;ERROR, DON'T CHANGE ANYTHING
	SKIPN	T1,ESCBLK	;QUOTE CHARACTER ALREADY EXIST?
	MOVEI	T1,"N"&37	;NO, SUPPLY ↑N
	MOVE	T2,ESCBLK+1	;ALLOW LACK OF SHIFT CHARACTER
	SKIPN	T3,ESCBLK+2	;LOCAL ESCAPE CHARACTER EXIST?
	MOVEI	T3,"←"&37	;NO, SUPPLY ↑←
	MOVE	T4,ESCBLK+3	;ALLOW LACK OF NETWORK ESCAPE
	PESC	T1		;SET ESCAPES AND QUOTES
	  IMPERR TELN4A		;SOMETHING ILLEGAL, BUT CONNECT ANYWAY
TELN4A:	XTTY	TELBLK		;CROSSPATCH THE TTY
	  IMPERR TELN4Q
	SKIPG	T1,ALLBTS	;SPECIAL ALLOCATION DESIRED?
	JRST	TELN4B		;NO
	MOVEM	T1,.IBRMT+TELBLK ;YES, STORE IN BLOCK
	HLRZM	P,.IBHST+TELBLK ;REQUEST MAXIMUM MESSAGE ALLOCATION
	SETALL	TELBLK		;DO IMPUUO
	  IMPERR .+1		;ERROR--COMPLAIN BUT IGNORE
TELN4B:	PUSHJ	P,XPWAIT	;WAIT UNTIL CROSSPATCH IS BROKEN
	SKPINL			;FLUSH POSSIBLE CONTROL-O
	  JFCL
	PESC	ESCBLK		;RESTORE THE OLD QUOTES AND ESCAPES
	  JFCL			;HAPPENS IF WE BECOME DETACHED
TELN4D:	EDisix	[TELN4Q,,[SIXBIT \#B&ACK TO % JOB %#!\]
		WAsc	THSHST		;TYPE LOCAL HOST NAME
		WDEC	JOBN]

;HERE WHEN MORE THAN ONE IMP SATISFIED THE COMMAND SPECS.
TELNE9:	EDisix	[STOP,,[SIXBIT \? A&MBIGUOUS SPECIFICATION#!\]]

;HERE TO GET TTY LINE CHARACTERISTICS IN FORCE AT END OF CROSSPATCH
;   AND STORE THEM IN THE USER PARAMETER WORD IN THE IMP DDB, THEN
;   REINSTATE THE LINE CHARACTERISTICS THAT WERE IN EFFECT BEFORE
;   THE CROSSPATCH WAS MADE
TELN4Q:	SETO	T1,		;FETCH CURRENT LINE BITS
	GETLCH	T1
	SETZ	T2,		;START NEW CONNECTION PARAMETER WORD
	TXZE	T1,GL.PTM	;STILL IN PAPER-TAPE MODE?
	TXO	T2,PW.NLF	;YES, REMEMBER NO LINEFEED DESIRED
	SETLCH	T1		;CLEAR PAPER TAPE MODE IN CASE SET
	STATZ	TTYCHN,IO.SUP	;SUPPRESSING ECHO?
	TXO	T2,PW.NEC	;YES, REMEMBER NO ECHO DESIRED
	SETSTS	TTYCHN,0	;NOW BRING BACK ECHOING
	MOVE	T1,(P1)		;FETCH IMP DEVICE NAME
	STAT	(P1)		;GET CURRENT STATUS
	  EDisix	[STOP,,[SIXBIT\C&ONNECTION NO LONGER OPEN#!\]]
	LDB	T3,[POINT 6,.IBSTT(P1),35] ;FETCH STATE
	CAIE	T3,.ISEst	;STILL OPEN?
	  EDisix	[STOP,,[SIXBIT\C&ONNECTION NO LONGER OPEN#!\]]
	PCPAR	T1		;YES, PUT LINE BITS INTO IMP DDB
	  JFCL			;OOP---
	JRST	STOP		;DONE
;ROUTINE TO SETUP ECHO STATE ACCORDING TO LAST STATE AND SWITCHES
ECHCHK:	TXNE	F,ECHSWT	;USER WANTS TO ECHO?
	TXNN	T3,PW.NEC	;YES, IS THAT WHAT WE'RE DOING?
	JRST	.+2		;NO TO 1ST OR YES TO SECOND
	JRST	ECHCMP		;WANTS TO ECHO, MUST TELL SERVER
	TXNE	F,NECSWT	;CONVERSELY, WANT SERVER TO ECHO?
	TXNE	T3,PW.NEC	;YES, WHAT'S SERVER DOING?
	JRST	ECHSET		;NO CHANGE, MAKE SURE WE'RE DOING ON TTY AS REQUIRED

;ROUTINE TO SWITCH ECHO STATE OF THE SERVER
ECHCMP:	FSetUp	FilOTL		; set up lowseg block (ImpFil)
	MOVE	T1,.IBDEV+TELOBK	;FETCH DEVICE NAME
	MOVEM	T1,ImpFil+FILDEV	;STORE IN FILE BLOCK
	FoGet	ImpFil		;OPEN TELNET CONNECTION FOR OUTPUT
	WCHI	.TNIAC		;START OFF COMMAND WITH AN IAC
	TXCN	T3,PW.NEC	;SWITCH. WERE WE ECHOING?
	WCHI	.TNDO		;YES, TELL SERVER TO
	TXNN	T3,PW.NEC	;ARE WE ECHOING NOW?
	WCHI	.TNDNT		;YES, TELL SERVER NOT TO
	WCHI	.TOECH		;AND SAY WE'RE NEGOTIATING ECHO
	FOCLOS	ImpFil		;CLOSE OUT FILE
	SETZM	OFile##
ECHSET:	TXNN	T3,PW.NEC	;SERVER ECHO?
	POPJ	P,		;NO, WE ARE
	SETSTS	TTYCHN,IO.SUP	;YES, SUPPRESS OURS
	OUTSTR	[ASCIZ//]	;TELL MONITOR
	POPJ	P,		;RETURN
;ERROR COMMAND.  GETS ERROR COUNTS AND STATISTICS.
I.ERRO:	PUSH	P,.JBFF		;REMEMBER FIRST FREE LOC
	PUSH	P,.JBREL	;AND CURRENT TOP OF LOW CORE
	HRRZ	T1,.JBFF	;WHERE TO START BUILDING TABLE
	HRLI	T1,T2		;AC TO INDEX INTO TABLE WITH
	MOVEM	T1,GTTOLD	;SAVE FOR LATER
	MOVEI	T2,GTBSiz(T1)	;TABLE SPACE WANTED (WITH ROOM FOR EXPANSION)
	MOVEM	T2,.JBFF	;SAVE NEW FIRST FREE
	CAMG	T2,.JBREL	;DO WE ALREADY HAVE THAT MUCH?
	JRST	.+3		;YES, PROCEED
	CORE	T2,		;NO, OBTAIN MORE FROM MONITOR
	  CMDERR [SIXBIT\? I&NSUFFICIENT CORE#!\]
	HRLI	T1,(T1)		;CLEAR THE TABLE
	AOS	T2,T1
	SETZM	-1(T1)
	BLT	T1,↑D199(T2)
	Clearm	WATIVL		;CLEAR WAIT INTERVAL
	Clearm	ErBits		; clear selection bits
	Hrlzi	T1,ERRARG	;SCAN THE REMAINDER OF THE COMMAND LINE
	TXNN	F,BRKFLG	;  (IF THERE IS ONE)
	PUSHJ	P,TEXTIN
	TXNE	F,<COMFGS+COMSWS-IVLFLG> ;CHECK SWITCHES
;[96bit]JRST	A.ESWT		;WRONG KIND
	  JRST	A.SWBD		;[96bit] can't use here
	MOVE	T1,SYSVER	;BEGIN TYPEOUT
	HLRZ	T2,T1
	Move	P4,ErBits	; make select bits convenient
	TLNN	P4,-1		;ANY SELECTED TYPEOUTS?
	Disix	[[SIXBIT\#NCP &VERSION %.% OPERATING STATISTICS%!\]
		WOCTI	(T1)	;NCP VERSION
		WOCTI	(T2)	;IMPSER VERSION
		HRLI	P4,-1]	;GIVE ALL TYPEOUTS
	Movem	P4,ErBits	; save them again

;BACK HERE TO BEGIN ANOTHER PASS OF THE ENTIRE SUMMARY.  ON THE FIRST
;  PASS, THE IN-CORE TABLE IS ALL ZERO AND THUS ALL NONZERO ENTRIES
;  GET PRINTED.  ON SUBSEQUENT PASSES, ONLY ITEMS THAT HAVE CHANGED
;  GET PRINTED.
IERR0:	MOVSI	P1,-NGTTBL	;NUMBER OF GETTAB SUBTABLES
	TIMER	T1,		;GET TIME WE STARTED THIS PASS
	MOVEM	T1,LASTIM	;SAVE FOR COMPUTING INTERVAL
	Disix	[[SIXBIT\##%%#------------#!\]
		PUSHJ	P,TTIME		;PRINT TIME AND DATE
		PUSHJ	P,TDATE]
;MAIN DRIVING LOOP FOR IMP ERROR STATISTICS FUNCTION
IERR1:	HRRZ	T1,GTTSTP(P1)	;GET SUBTABLE POINTER INDEX
	HLL	T1,ErBits	;GET REQUEST BITS
	LSH	T1,(T1)		;SHIFT APPROPRIATE BIT TO SIGN
	JUMPGE	T1,IERR8		;JUMP IF DON'T WANT THIS PRINTOUT
	TXZ	F,TITLTY	;CLEAR TITLE FLAG
	HLLZ	P2,GTTSTP(P1)	;GET NEG. NUMBER OF ENTRIES IN SUBTABLE
	HRLZ	P3,GTTSTP(P1)	;GET SUBTABLE NUMBER
	HRRI	P3,.GTIMP	;SELECT IMP GETTAB TABLE
	GETTAB	P3,		;RETURN SUBTABLE POINTER
	  JRST	IERR8		;LOST THAT ONE
	HRLI	P3,P2		;SET INDEX FIELD FOR @
	MOVE	P4,GTTDSP(P1)	;FETCH DISPATCH ENTRY FOR SUBTABLE

;LOOP REPEATED FOR EACH ITEM IN A SUBTABLE
IERR2:	MOVSI	T1,@P3		;COMPUTE ACTUAL .GTIMP ENTRY FOR ITEM
	HLRZ	T2,T1		;SAVE FOR INDEX INTO IN-CORE TABLE
	HRRI	T1,.GTIMP	;SELECT IMP GETTAB TABLE
	GETTAB	T1,		;GET THE ITEM
	  JRST	IERR5		;NOT TODAY
	CAMN	T1,@GTTOLD	;HAS IT CHANGED SINCE LAST WE LOOKED?
	TLNE	P4,(EG.ACR)	;NO, BUT CHECK FOR ALWAYS-CALLED-ROUTINE
	PUSHJ	P,(P4)		;CALL ROUTINE TO PRINT ENTRY
	  MOVEM	T1,@GTTOLD	;SAVE AS PREVIOUS VALUE OF THIS ITEM
IERR5:	AOBJN	P2,IERR2	;REPEAT FOR EACH ITEM IN SUBTABLE
IERR8:	AOBJN	P1,IERR1	;REPEAT FOR ALL SUBTABLES

;LOOP HERE WHILE TIMING REPORT INTERVAL
IERR8A:	SKIPN	T1,WATIVL	;WAIT INTERVAL SPECIFIED?
	JRST	IERR9		;NO, FINISH UP
	IMULI	T1,↑D60		;YES, CONVERT INTERVAL TO JIFFIES
	ADD	T1,LASTIM	;COMPUTE TIME FOR NEXT REPORT
	TIMER	T2,		;RETURN CURRENT TIME OF DAY
	CAMGE	T2,T1		;HAVE WE ARRIVED AT NEXT REPORT TIME?
	CAMGE	T2,LASTIM	;NO, BUT LOOK OUT FOR MIDNIGHT
	JRST	IERR0		;TIME FOR A NEW REPORT
	SUB	T1,T2		;NOT YET, COMPUTE REMAINING TIME IN JIFFIES
	IDIVI	T1,↑D60		;CONVERT TO SECONDS
	CAIL	T1,↑D60		;MORE THAN A SLEEP'S WORTH?
	MOVEI	T1,↑D60		;YES, CUT DOWN TO 1 MINUTE
	SLEEP	T1,		;WAIT A WHILE
	JRST	IERR8A		;RECHECK WAITING TIME

;HERE TO FINISH UP COMMAND
IERR9:	POP	P,P4		;FLUSH SUBTABLE BITS
	POP	P,T1		;GET BACK OLD CORE
	CAMGE	T1,.JBREL	;LESS THAN CURRENT?
	CORE	T1,		;YES, RETURN SOME
	  JFCL
	POP	P,.JBFF		;RESTORE FREE PTR
	JRST	STOP
;TABLES FOR DRIVING 'IMP ERROR' OUTPUT

	EG.ACR==1B0	;ALWAYS CALL ITEM ROUTINE (EVEN IF ENTRY ZERO)

DEFINE GTTBLS <
	SUBTBL	16,IHM,<>	;;IMP-HOST MESSAGES
	SUBTBL	5 ,EPL,<>	;;[96bit] error in previous leader
	SUBTBL	7 ,INC,<>	;;[96bit] incomplete transmission
	SUBTBL	8 ,DMF,<>	;;IMP DATA MESSAGE FAULTS
	SUBTBL	3 ,BHS,<>	;;BUFFER HANDLING STATISTICS
	SUBTBL	24,HMS,<>	;;HISTOGRAM OF MESSAGE SIZES
	subtbl	5 ,IPE,<>	;; IP errors
	subtbl	3 ,IPD,<>	;; IP data
	subtbl	4 ,ICE,<>	;; ICMP errors
	subtbl	20,ICM,<>	;; ICMP types
	subtbl	15,TCE,<>	;; TCP errors
	subtbl	6 ,TCI,<>	;; TCP input types
	subtbl	6 ,TCO,<>	;; TCP output types
>

;LENGTHS AND SUBTABLE NUMBER TABLE
DEFINE SUBTBL(N,STN,FLAGS) <
	-↑D'N	,, <%IS'STN>B53
	GTBSiz==GTBSiz+↑d'N		;; add to table size
>

GTBSiz==0	; assume there are no gettab entries

GTTSTP:	GTTBLS

	NGTTBL==.-GTTSTP	;NUMBER OF SUBTABLES

;FLAGS AND DISPATCH ADDRESSES
DEFINE SUBTBL(N,STN,FLAGS) <
	ZZ==	0
IFNB <FLAGS>,<IRP FLAGS <ZZ==ZZ!EG.'FLAGS>>
	ZZ + GTT'STN
>

GTTDSP:	GTTBLS
;SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
GTTDMF:	TXON	F,TITLTY	;NEED TO TYPE TITLE?
	WSIX	[SIXBIT\#IMP &DATA MESSAGE FAULTS:#!\]
	Disix	[Cpopj##,,[SIXBIT\  %: %#!\]
		WSIX	@IMPDMF(P2)
		WDEC	T1]

;LABELS FOR IMP DATA MESSAGE FAULTS
IMPDMF:	[SIXBIT\H&ARDWARE FAULT!\]
	[sixbit\P&rotocol not &IP!\]
	[SIXBIT\B&AD MESSAGE TYPE!\]
	[SIXBIT\D&ISCARDED &RFNM&S!\]
	[SIXBIT\S&IMULATED (TIMED OUT) &RFNM&S!\]
	[SIXBIT\B&AD MESSAGE SIZE!\]
	[sixbit \O&ut of buffers during TTY output!\]
	[sixbit \IMPMAK& failures!\]
;SUBROUTINE TO TYPE IMP MESSAGE TYPES
GTTIHM:	TXON	F,TITLTY	;TITLE IF NEEDED
	WSIX	[SIXBIT\#R&ECEIVED &IMP& MESSAGES:#!\]
	Clearm	ChrCnt		; set to column 0
	WSIX	@IMPNAM(P2)	;TYPE LABEL
	WTAB	↑D10
	WDEC	7,T1		;TYPE VALUE
	PJrst	TCrLf		; type a crlf and return

;IMP MESSAGE TYPE LABELS
IMPNAM:	[SIXBIT\R&EGULAR!\]
	[SIXBIT\E&RR W/O ID!\]
	[SIXBIT\IMP &DOWN!\]
	[SIXBIT\B&LK'D LINK!\]
	[SIXBIT\NOP!\]
	[SIXBIT\RFNM!\]
	[SIXBIT\D&d hst sts!\]
	[SIXBIT\D&EST DEAD!\]
	[SIXBIT\E&RR W/ID!\]
	[SIXBIT\I&NC TRANS!\]
	[SIXBIT\IMP &RESET!\]
	[SIXBIT\11!\]
	[SIXBIT\12!\]
	[SIXBIT\13!\]
	[SIXBIT\14!\]
	[SIXBIT\15!\]


;[96bit] error in previous leader messages from the imp
GTTEPL:	TXON	F,TITLTY	;TITLE IF NEEDED
	WSIX	[SIXBIT\#E&RROR IN PREVIOUS LEADER MESSAGES:#!\]
	Clearm	ChrCnt		; set to column 0
	WSIX	@EPLCOD(P2)	;TYPE LABEL
	WTAB	↑D20
	WDEC	7,T1		;TYPE VALUE
	PJrst	TCrLf		; type a crlf and return

EPLCOD:	[SIXBIT \E&RROR FLIPFLOP SET!\]
	[SIXBIT \M&ESSAGE TOO SMALL!\]
	[SIXBIT \I&LLEGAL MESSAGE TYPE!\]
	[SIXBIT \L&EADER FORMAT WRONG!\]
	[SIXBIT \E&RROR NUMBER WAS BAD!\]


GTTINC:	TXON	F,TITLTY	;TITLE IF NEEDED
	WSIX	[SIXBIT\#I&ncomplete transmission messages:#!\]
	clearm	chrcnt		;set to column 0
	WSIX	@INCCOD(P2)	;TYPE LABEL
	WTAB	↑D20
	WDEC	7,T1		;TYPE VALUE
	PJrst	TCrLf		; type a crlf and return

INCCOD:	[SIXBIT \D&ESTINATION HOST DID NOT ACCEPT MESSAGE QUICKLY ENOUGH!\]
	[SIXBIT \M&ESSAGE WAS TOO LONG!\]
	[SIXBIT \H&OST TOOK TOO LONG TO TRANSMIT MESSAGE TO &IMP&!\]
	[SIXBIT \M&ESSAGE LOST IN THE NETWORK DUE TO &IMP& OR CIRCUIT FAILURE!\]
	[SIXBIT \IMP &COULD NOT ACCEPT THE ENTIRE MESSAGE!\]
	[SIXBIT \IMP I/O &FAILURE DURING RECEIPT OF MESSAGE!\]
	[SIXBIT	\E&RROR NUMBER WAS BAD!\]

;ROUTINE TO TYPE THE DATA MESSAGE SIZE HISTOGRAM
GTTHMS:	TXON	F,TITLTY	;NEED TITLE?
	WSIX	[SIXBIT\#H&ISTOGRAM OF RECEIVED DATA MESSAGE SIZES#∨
&B&ITS    &C&OUNT#!\]
	Clearm	ChrCnt		; set to column 0
	MOVEI	T3,1		;COMPUTE POWER OF 2
	LSH	T3,(P2)
	Disix	[Cpopj##,,[SIXBIT\<%%%#!\]
		WDEC	T3
		WTAB	↑D6
		WDEC	7,T1]
;ROUTINE TO TYPE BUFFER STATISTICS
GTTBHS:	TXON	F,TITLTY	;NEED TITLE?
	W2CHI	CRLF		;NOT REALLY, BUT SOME SPACE IS NICE
	MOVEI	T3,↑D50(T1)	;TURN INTO T1 PERCENTAGE
	IDIVI	T3,↑D100
	MOVEI	T4,(P2)		;GET SUBTABLE INDEX
	CAIN	T4,%ISAFB	;IS IT THE BUFFER AVERAGE?
	MOVE	T1,T3		;YES, GET THE THING WE JUST COMPUTED
	WDEC	T1
	WSIX	@BHSTAB(P2)
	POPJ	P,

;LABELS FOR BUFFER HANDLING STATISTICS
BHSTAB:	[SIXBIT\ &BUFFER OVERRUNS#!\]
	[SIXBIT\ &FREE BUFFERS#!\]
	[SIXBIT\"% &AVERAGE BUFFER UTILIZATION#!\]
;SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
GTTIPE:	TXON	F,TITLTY	;NEED TO TYPE TITLE?
	  WSIX	[SIXBIT\#IP& errors:#!\]
	Disix	[Cpopj##,,[SIXBIT\  %: %#!\]
		WSIX	@IPETxt(P2)
		WDEC	T1]
IPETxt:
	[sixbit \N&ot enough bytes for &IP& leader!\]
	[sixbit \U&nknown protocol!\]
	[sixbit \W&rong version!\]
	[sixbit \L&eader checksum failed!\]
	[sixbit \U&nknown option seen!\]
;SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
GTTIPD:	TXON	F,TITLTY	;NEED TO TYPE TITLE?
	  WSIX	[SIXBIT\#IP& statistics:#!\]
	Disix	[Cpopj##,,[SIXBIT\  %: %#!\]
		WSIX	@IPDTxt(P2)
		WDEC	T1]
IPDTxt:
	[sixbit \M&essages parsed with options!\]
	[sixbit \F&ragmented messages seen!\]
	[sixbit \F&ragmented messages reassembled!\]
;SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
GTTICE:	TXON	F,TITLTY	;NEED TO TYPE TITLE?
	  WSIX	[SIXBIT\#ICMP& errors:#!\]
	Disix	[Cpopj##,,[SIXBIT\  %: %#!\]
		WSIX	@ICETxt(P2)
		WDEC	T1]
ICETxt:
	[sixbit \N&ot enough bytes for &ICMP& leader!\]
	[sixbit \N&ot enough bytes for &ICMP& message!\]
	[sixbit \C&hecksum failed!\]
	[sixbit \T&ype unknown!\]
;SUBROUTINE TO TYPE IMP MESSAGE TYPES
GTTICM:	TXON	F,TITLTY	;TITLE IF NEEDED
	  WSIX	[SIXBIT\#R&ECEIVED &ICMP& MESSAGES:#!\]
	Clearm	ChrCnt		; set to column 0
	WSIX	@ICMTxt(P2)	;TYPE LABEL
	WTAB	↑D20
	WDEC	7,T1		;TYPE VALUE
	PJrst	TCrLf		; type a crlf and return

ICMTxt:
	[sixbit \E&cho reply!\]
	[sixbit \1!\]
	[sixbit \2!\]
	[sixbit \D&estination unreachable!\]
	[sixbit \S&ource quench!\]
	[sixbit \R&edirect!\]
	[sixbit \6!\]
	[sixbit \7!\]
	[sixbit \E&cho!\]
	[sixbit \9!\]
	[sixbit \10!\]
	[sixbit \T&ime exceeded!\]
	[sixbit \P&arameter problem!\]
	[sixbit \T&imestamp!\]
	[sixbit \T&imestamp reply!\]
	[sixbit \I&nformation request!\]
	[sixbit \I&nformation reply!\]
	[sixbit \17!\]
	[sixbit \18!\]
	[sixbit \19!\]
;SUBROUTINE TO PRINT IMP DATA MESSAGE FAULTS
GTTTCE:	TXON	F,TITLTY	;NEED TO TYPE TITLE?
	  WSIX	[SIXBIT\#TCP& errors:#!\]
	Disix	[Cpopj##,,[SIXBIT\  %: %#!\]
		WSIX	@TCETxt(P2)
		WDEC	T1]
TCETxt:
	[sixbit \N&ot enough bytes for &TCP& leader!\]
	[sixbit \N&ot enough bytes for &TCP& message!\]
	[sixbit \C&hecksum failed!\]
	[sixbit \P&ort not supported!\]
	[sixbit \C&ould not get &DDB& for incoming connection!\]
	[sixbit \C&ould not get &ITY& for incoming connection!\]
	[sixbit \U&nknown option seen!\]
	[sixbit \TCP& leader with options seen!\]
	[sixbit \TCP& message tranmission queue pointers wrong!\]
	[sixbit \TCP& packets retransmitted!\]
	[sixbit \M&essages received which were not next!\]
	[sixbit \M&essages previously not next which were used!\]
	[sixbit \M&essages completely out of receive window!\]
	[sixbit \M&essages with front out of receive window!\]
	[sixbit \M&essages with end out of receive window!\]
; type output TCP types
GTTTCO:	TXON	F,TITLTY	;TITLE IF NEEDED
	  WSIX	[SIXBIT\#S&ent &TCP& MESSAGES:#!\]
	jrst	GTTTCX

; type input TCP types
GTTTCI:	TXON	F,TITLTY	;TITLE IF NEEDED
	  WSIX	[SIXBIT\#R&ECEIVED &TCP& MESSAGES:#!\]
GTTTCX:	Clearm	ChrCnt		; set to column 0
	WSIX	@TCPTyp(P2)	;TYPE LABEL
	WTAB	↑D13
	WDEC	7,T1		;TYPE VALUE
	PJrst	TCrLf		; type a crlf and return

TCPTyp:
	[sixbit \FIN!\]
	[sixbit \SYN!\]
	[sixbit \R&eset!\]
	[sixbit \PUSH!\]
	[sixbit \ACK&nowlege!\]
	[sixbit \U&rgent!\]
;HELP COMMAND -- PROVIDES HELPING TEXT

I.HELP:	FIOPEN	HLPFIL		;OPEN HELP FILE FOR INPUT
	INBUF	HLPCHN,1	;NEED ONE BUFFER TO SYNCHRONIZE INPUT
	MOVEI	T1,HLPNDX
	TXNE	F,BRKFLG	;END OF LINE?
	JRST	HELP2		;YES
HELP1:	SETZM	IFile##		;READ FROM TTY
	CALL	GETSYM		;GET A FIELD
	JUMPE	A,A.ECMD	;ERROR IF EMPTY
	MOVE	T2,COMLST	;SEARCH FOR MATCH
;[96bit]CALL	SIXSRC		;AMONG COMMAND LIST
	Call	SixSrA		; check for A in commands
	  JRST	HELP3
HELP2:	MOVE	T1,COMXCT(T1)	;GET RIGHT HELP ENTRY
	JRST	HELP3A		;DO IT

;HERE TO TRY SECOND HELP LIST
HELP3:	Exch	T1,A		; recall arg, save results
	MOVE	T2,HLPLST	;SEARCH
	CALL	SIXSRC
;[96bit]  JRST	A.ECMD		;ERROR IF NOT FOUND
	  Jrst	[		; still not found
		 Or	T1,A	; ambiguous if ambiguous in one list.
		 TabErr	[Sixbit \HELP& argument!\]	; give error
		]
	MOVE	T1,HLPXCT(T1)	;GET THE RIGHT HELP ENTRY
HELP3A:	HLRZ	T2,T1		;GET INDEX INTO HELP FILE
	FISEL	HLPFIL		;SELECT FILE FOR INPUT
	PUSHJ	P,(T1)		;DO HELP OPERATION
	TXNN	F,BRKFLG	;DONE?
	JRST	HELP1		;NO
	JRST	STOP		;YES
;ROUTINE TO DO HELP WITH NO ARGUMENTS
HELP4:	WSIX	VERMSG		;TYPE VERSION NUMBER OF IMPCOM
	WSIX	[SIXBIT \T&HE FOLLOWING COMMANDS ARE AVAILABLE:#!\]
	MOVE	T2,COMLST	;LIST ALL OF THE COMMANDS
	CALL	TYPLST
	MOVEI	T2,MHELP##	;TYPE STANDARD MESSAGE
	PUSHJ	P,HLPTYP
	MOVE	T2,HLPLST	;TYPE REMAINING HELP ARGUMENTS
	JRST	TYPLST

;ROUTINE TO TYPE THE HELP MESSAGE WHOSE RELATIVE ADDRESS IN THE FILE
;   IS GIVEN IN B.
HLPTYP:	IDIVI	T2,200		;SEPARATE BLOCKS AND WORDS
	IMULI	T3,5		;TURN REMAINDER INTO BYTES
	SETZM	HLPFIL+FILCTR	;FORCE READ
	USETI	HLPCHN,1(T2)	;SELECT THE RIGHT BLOCK
	RCH	T1		;READ T1 CHARACTER
	SOJG	T3,.-1		;  UNTIL WE GET TO THE MESSAGE
	WCH	T1		;PRINT IT
	RCH	T1		;GET NEXT
	JUMPN	T1,.-2		;CONTINUE TO END OF MESSAGE
	POPJ	P,		;DONE

;HANDLE ERRORS READING HELP FILE
HLPER1:	ERRIOP	HLPFIL		;INPUT OPEN FAILURE
	JRST	STOP
HLPER2:	ERRLK	HLPFIL		;LOOKUP FAILURE
	JRST	STOP
HLPER3:	ERRIN	HLPFIL		;INPUT ERROR
	JRST	STOP

;IMPCOM VERSION NUMBER
Define XX(V,U,E,W)<
	Ifnb <W>,<Sixbit \V'U(E)-W#!\>
	Ifb <W>,<Sixbit \V'U(E)#!\>
>
VERMSG:	VerStr		; set up the string, according to XX
			; (Verstr is "XX V,U,E,W" from VERSION)
;ASSEMBLE HELP NAME TABLE

	DEFINE	CC(A) <
IRP A<	<SIXBIT	\A\>
>>

HLPNAM:	HELPS

HLPLST:	HLPNAM-.,,HLPNAM
;HELP DISPATCH TABLE

	DEFINE	CC(A,F) <
IFDIF <A><HELP>,<
	M'A##  	,, HLPTYP
>
IFIDN <A><HELP>,<
	HLPNDX==.-COMXCT
	M'A##  	,, HELP4
>>

COMXCT:	COMS

HLPXCT:	HELPS
SUBTTL ACTION ROUTINES FOR LEXICAL INTERPRETER


;Subroutine to check for a recognized monitor command, and figure
;  out what it's trying to tell us.  If it's not recognized, we
;  assume it's "run" or some such, so we flush input and prompt.
A.ICHK:	Move	T2,MonPnt	; point at the monitor commands
	Call	SixSrA		; try to find A there
	  Jrst	NotMon		; not a monitor command i recognize
	Skipn	A,MonEql(T1)	; grab the equivalent impcom command
	  Return		; none: continue scanning the line
	LCh	P2		; back pedal: put back next char.
	Jrst	A.Ret##		; that was easy: return command

NotMon:	Txo	F,RunFlg	; flag that there's no command to parse
	CALL	FLUSH		;THROW AWAY LINE
	WCHI	"*"		;PROMPT
	RChf	P2		; get the first character
	RETURN

; monitor commands ImpCom may recognize
MonCom:	Sixbit	.ImpCom.	; standard monitor intro
	Sixbit	.Tn.		; abbreviation for TelNet
	Sixbit	.Connec.	; "Connect" also means "TelNet"

MonPnt:	MonCom-.,,MonCom	; pointer to table

; equivalences: what the monitor commands want ImpCom to do
MonEql:	0			; IMPCOM=nothing, just start parsing
	Sixbit	.TelNet.	; TN=TelNet
	Sixbit	.TelNet.	; CONNECT=TelNet
;SUBROUTINE TO INITIALIZE FOR FIELD OR NAME INPUT
A.TINI:	TXZ	F,SEPARA	;[96bit] "." not seen yet
	SETZM	HstAdr		;[96bit] CLEAR HOST NUMBER
	Txne	F,HstFlg	; have a host in the buffer?
	  Tdza	B,B		; make stores go out the window.
	Move	B,[Point 7,AscBuf]	; point at the ascii buffer
	Move	C,[POINT 6,A]	; set the sixbit word pointer
A.NINI:	Clear	A,		; clear the sixbit word or number
A.Fini:	MOVEI	T1,↑D10		;SET RADIX 10
	MOVEM	T1,RADIX
	TXZ	F,LETFLG	;CLEAR LETTER FLAG
;[96bit]SETZM	HstAdr		;CLEAR HOST NUMBER
	RETURN

A.OINI:	MOVEI	T1,↑D8
	MOVEM	T1,RADIX
	RETURN

;HERE TO PACK ANOTHER DECIMAL DIGIT
A.DPAK:	IMUL	A,RADIX		;DECIMAL DIGIT
	ADDI	A,-"0"(P2)	;PACK IT
	RETURN

;HERE TO PACK ANOTHER SIXBIT CHARACTER
A.TPAK:	Came	B,[Point 7,AscEnd,27]	; any more room in ascii buf?
	  Idpb	P2,B		; yes: put char in buffer
	CAIGE	P2,↑O140	;UPPER CASE?
	SUBI	P2,↑O40		;YES. CONVERT TO SIXBIT
	TRNN	A,↑O77		;MAKE SURE OF ROOM
	IDPB	P2,C		;DEPOSIT CHARACTER
	Caie	P2,"-"		; is it a dash?  (dash is a letter)
	TXNN	P3,DIGIT	;IS IT A DIGIT?
	TXOA	F,LETFLG	;NO
	TXNE	F,LETFLG	;ANY LETTERS SO FAR?
	POPJ	P,		;YES, DON'T DO ANY NUMERIC STUFF
	EXCH	T1,HstAdr	;NO, MIGHT WANT NUMBER LATER
	IMUL	T1,RADIX		;SO...
	ADDI	T1,40-"0"(P2)	;   BUILD
	EXCH	T1,HstAdr	;    IT  UP
	Return

;[96bit] routines to parse host/site number
A.HNPK:	TXOE	F,SEPARA	;[96bit] remember we've started
	  JRST	HNPK1		;[96bit] already been here before
	EXCH	A,HstAdr	;[96bit] get host number, store
				;	 the imp number in place
	DPB	A,HSTPLC	;[96bit] put host no. in place
	Return			; and go back to work

HNPK1:	push	p,a			;[tcp] save what we now know is
					;[tcp]  the IMP number
	move	a,HstAdr		;[tcp] get address as given so far
	txne	a,ih.Net		;[tcp] a net number yet?
	  jrst	[			;[tcp] yes.  must be giving
					;[tcp]  double imp field.
		 ldb	a,ImpPlc	;[tcp] get old imp field
		 lsh	a,↑d8		;[tcp] shift over to next 8 bit field
		 ior	a,(p)		;[tcp] mush new in with new old.
		 dpb	a,ImpPlc	;[tcp] put back in place
		 pop	p,a		;[tcp] clear stack
		 return			;[tcp] return to parsing
		]
	ldb	a,HstPlc		;[tcp] get what we thought was
					;[tcp]  a host number
	DPB	A,NETPLC		;[tcp] turned out to be the net number
	ldb	a,ImpPlc		;[tcp] get imp number
	dpb	a,HstPlc		;[tcp] except we now know that it's
					;[tcp]  the host number.
	pop	p,a			;[tcp] recover real imp number
	dpb	a,ImpPlc		;[tcp] store where it should be.
	RETURN			;[96bit] and back to parsing

IMPPLC:	Pointr	(HstAdr,Ih.Imp)	;[96bit] host number position
HSTPLC:	Pointr	(HstAdr,Ih.Hst)	;[96bit] host number position
NETPLC:	Pointr	(HstAdr,Ih.Net)	;[96bit] network number position
;HERE TO SAVE COMBLK NAME
A.DSAV:	MOVEM	A,.IBDEV+COMBLK
	TXON	F,DEVFLG
	RETURN			;OK

;HERE ON SWITCH ERROR
A.ESWT:	CMDERR	SWTERM		;TYPE MESSAGE AND EXIT

;[96bit] here when we found an improper switch on
A.SWBD:	CMDERR	BADSWT		;[96bit] bad switch seen

;HERE ON COMMAND ERROR
A.ECMD:	CMDERR	CMDERM


; figure out a host field
A.SHst:	TXOE	F,HSTFLG	;REMEMBER HOST SEEN, CHECK FOR 2ND
	 CmdErr	[Sixbit \? M&ore than one host specified.#!\]
	Txnn	F,LetFlg	; seen any letters?
	  Jrst	HstLgl		; nope: must be a number
	Setz	T1,		; make sure name is ascii
	idpb	T1,B		; by ending with zero
	Txne	F,HstCmd	; are we in a host command?
	  Return		; yes: let it handle anything.
	Movei	T1,AscBuf	; check the string for a host name
	Call	HstNam##	; is this a host name?
	  CmdErr [Sixbit \? H&ost tables cannot be read.  &P&lease use host numbers.#!\]
	  Jrst	AnyHst		; none: make a list of possibilities
	Dpb	T2,PHostN	; put it in the block
	Return			; squared away

;[96bit] check for legal host, and do some necessary twiddling
HstLgl:	Move	T1,HstAdr	; retrieve the host number
	TXZN	F,SEPARA	;[96bit] did we get the site and host
				;	 separately?
	  CALL	HstCon		;[96bit] no: convert from old to new.
	skipe	t1			;[tcp] don't allow zero
	 TXNE	T1,<-1-<Ih.Net!Ih.Hst!Ih.Imp>>	;[96bit] any bad bits?
	 EDisix	[SpecEr,,[Sixbit \? H&ost number!\]]
	;[96bit] until networks are here, check to see if he's trying
;[tcp]	TXNE	T1,Ih.Net	;[96bit] any network number given?
;[tcp]	 CMDERR	[Sixbit \? M&ultiple networks not yet available#!\]
	txnn	t1,ih.Net			;[tcp] got a net number?
	  txo	t1,<insvl. (↑d10,ih.Net)>	;[tcp] no.  assume arpanet
	Dpb	T1,PHostN	; put it in the block
	Return			; and return
; try to give a list of possible hosts.
AnyHst:	Txz	F,NckNam	; clear nick name flag
	Txo	F,TtlSwt	; remember haven't yet explained.
	Movei	T1,AscBuf	; point to the string again
	Movei	T2,HstLst	; where to go for each host
	Movei	T3,GotNck	; standard nickname parser
	Call	HstGen##	; go to it
	  Pjrst	NoHTbl		; can't find host table????
	  Pjrst	NotThr		; say nothing matches that.
	Call	NckCln		; add close ) for nickname, and <crlf>
	PJrst	Stop1A		; end.  go restart.

; when listing ambiguous host spec, come here for each host
HstLst:	Txze	F,TtlSwt	; explained yet?
	 EDisix	[[Sixbit \&? ""%"" is an ambiguous host name:#!\]
		 Wasc	AscBuf			; replay what was typed
		]
	Call	NckCln		; end nicknames if needed, add <crlf>
	Clearm	ChrCnt		; set to column 0
	WChi	Tab		; tab over one
	WAsc	(T1)		; output the host name
	Return

; routines to decide why a switch is bad

; first, switch without parameter
SwtBdA:	Move	T2,ParLst	; search the switches which do take parm
	Movei	B,[SixBit \&must have!\]  ; what to say if found there
	Jrst	SwtBa1		; now jump to common code

; now for switches that do take parameters
SwtBad:	Move	T2,SwtLst	; search parameter-less switch list
	Movei	B,[SixBit \&cannot have!\]  ; what to say if found there

SwtBa1:	Jumpl	T1,SwtAmb	; false alarm: switch was ambiguous
	Call	SixSrA		; check the opposite table
	 TabErr	SwtStr		; really not around: explain why.
	EDisix	[Stop1a,,[SixBit \T&he switch ""%"" % an argument.#!\]
		 WName	A	; what we were looking for
		 WSix	(B)	; what was wrong with it
		]

SwtAmb:	Jsp	T2,TabDcd	; ambiguous: go into normal table print
SwtStr:	Sixbit	\&switch!\	; sixbit string for error printing
;SAVE THE PARAMETER
A.PSAV:	MOVE	T2,PARLST	;FIND IT
;[96bit]CALL	SIXSRC
;[96bit]  JRST	A.ESWT
	Call	SixSrA		; search the table for the value in A
	  Jrst	SwtBad		; figure out what was wrong with it
	HRRZM	T1,PPARAM
	RETURN

;PARAMETER VALUE
A.PVAL:	MOVE	T4,PPARAM	;GET REMEMBERED INDEX
	Move	T1,A		; position value
	TXNN	T1,40B5		;SYMBOL?
	JRST	PVAL2		;NO
	SKIPN	T2,PARSYM(T4)	;SYMBOLIC OK?
;[96bit]  JRST	A.ESWT
	 CMDERR	[Sixbit \? S&witch Argument must be a number#!\];[96]
	JUMPG	T2,(T2)		;GO TO SUBROUTINE
	CALL	SIXSRC		;YES.  SEARCH
;[96bit]  JRST	A.ESWT
	 TABERR	[Sixbit \&SWITCH ARGUMENT!\]	;[96bit]
	MOVE	T4,PPARAM	;GET INDEX AGAIN
PVAL1:	XCT	PARVAL(T4)	;GET THE VALUE
PVAL2:	TDOE	F,PARFLG(T4)	;SET FLAG, SKIP IF OFF
	JRST	PVAL3
	DPB	T1,PARTAB(T4)	;DEPOSIT THE VALUE
	RETURN


;HERE IF FLAG ALREADY SET
PVAL3:	LDB	T2,PARTAB(T4)	;GET PREVIOUS VALUE
	CAME	T2,T1		;BETTER BE SAME
;[96BIT]JRST	A.ESWT
	 CMDERR	[Sixbit \? S&witch contradicts previous input#!\];[96]
	RETURN

;HERE TO HANDLE SWITCH WITHOUT VALUE
A.SSWT:	MOVE	T2,SWTLST
;[96bit]CALL	SIXSRC		;FIND IT
;[96bit]  JRST	A.ESWT		;NOT THERE
	Call	SixSrA		; find it, using parameter in A
	  Jrst	SwtBdA		; figure out what was wrong.
	XCT	SWTXCT(T1)	;DO IT
	  JRST	A.ESWT
	RETURN

;HERE TO HANDLE SUBFIELD OF 'ERROR' COMMAND
A.ESRC:	MOVE	T2,ERRLST	;SEARCH FOR NAME IN ERROR TABLE
;[96bit]PUSHJ	P,SIXSRC
;[96bit]  JRST	A.ECMD		;NOT FOUND
	Call	SixSrA		; find the parameter in A
	 TABERR	[Sixbit \ERROR& ARGUMENT!\]
	Move	T1,ErrBit(T1)	; get the bits
	Iorm	T1,ErBits	; and or them in with the others.
	POPJ	P,
PARLST:	-PARLEN,,PARNAM

PARNAM:
;[96bit]SIXBIT	\HOST\		Host switch removed[96bit]
	SIXBIT	\SITE\
	SIXBIT	\LOCAL\
	SIXBIT	\REMOTE\
;[tcp]	SIXBIT	\BYTESI\
JOBNAM:	SIXBIT	\JOB\
	SIXBIT	\STATE\
	SIXBIT	\USER\
	SIXBIT	\WAIT\
	SIXBIT	\INTERV\
	SIXBIT	\ALLOCA\

	PARLEN==.-PARNAM

PARFLG:
;[96bit]HSTFLG			Host switch removed[96bit]
	SITSWT
	LCLFLG
	RMTFLG
;[tcp]	BYTFLG
	JOBFLG
	STTFLG
	USRFLG
	WATFLG
	IVLFLG
	ALLFLG

PARTAB:
PHOSTN:
;[96bit]POINT	 8, .IBHST+COMBLK, 35	Host switch removed[96bit]
;[96bit]POINT	 8, .IBHST+COMBLK, 35
	POINT	32, .IBHST+COMBLK, 35	;[96bit]
	POINT	32, .IBLCL+COMBLK, 35
	POINT	36, .IBRMT+COMBLK, 35
;[tcp]	POINT	18, .IBBYT+COMBLK, 17
	POINT	18, .IBSTT+COMBLK, 17
	POINT	 6, .IBSTT+COMBLK, 35
	POINT	23, .IBLCL+COMBLK, 26
PWATCD:	POINT	 3, WAITCD##, 35
	POINT	36, WATIVL, 35
	POINT	36, ALLBTS, 35
PARSYM:
;[96bit]EXP	0		;'HOST'		Host switch removed[96bit]
	EXP	0		;'SITE'
	EXP	0		;'LOCAL'
	EXP	0		;'REMOTE'
;[tcp]	EXP	0		;'BYTESIZE'
	-1,,SLFNAM		;'JOB'
STTLST:	NSTATE,,STATES		;'STATE'
	-1,,SLFNAM		;'USER'
	EXP	0		;'WAIT'
	EXP	0		;'INTERVAL'
	EXP	0		;'ALLOCATE'

PARVAL:
;[96bit]JFCL			;'HOST'		Host remove[96bit]
	JFCL			;'SITE'
	JFCL			;'LOCAL'
	JFCL			;'REMOTE'
;[tcp]	JFCL			;'BYTE'
	MOVE	T1,JOBN		;'JOB'
	JFCL			;'STATE'
	HRRZ	T1,PRJPRG	;'USER'
	JFCL			;'WAIT'
	JFCL			;'INTERVAL'
	JFCL			;'ALLOCATE'

ERRLST:	-ERRLEN ,, ERRNAM
ERRNAM:	SIXBIT	\IMPMES\
	SIXBIT	\IMPFLT\
	Sixbit	\EPLCNT\
	Sixbit	\INCCNT\
	SIXBIT	\HISTOG\
	SIXBIT	\BUFFER\
	Sixbit	\ERRORS\
	sixbit	\IPData\
	sixbit	\TCPDat\

	ERRLEN==.-ERRNAM

ERRBIT:	1B<<%ISIHM>B53>
	1B<<%ISDMF>B53>
	1B<<%IsEPL>B53>
	1b<<%IsINC>B53>
	1B<<%ISHMS>B53>
	1B<<%ISBHS>B53>
	1B<<%ISEPL>B53>!1b<<%IsINC>B53>!1b<<%IsIPE>B53>!1b<<%IsICE>B53>!1b<<%IsTCE>B53>!1B<<%IsDMF>B53>
	1b<<%IsIPD>B53>!1b<<%IsIPE>B53>!1b<<%IsICD>B53>!1b<<%IsICE>B53>
	1b<<%IsTCE>B53>!1b<<%IsTCI>B53>!1b<<%IsTCO>B53>
;SWITCH TABLES

;LIST OF SWITCH NAMES
SWTNAM:	SIXBIT	\ALL\
INPNAM:	SIXBIT	\INPUT\
	SIXBIT	\OUTPUT\
SLFNAM:	SIXBIT	\SELF\
	SIXBIT	\SLOW\
	SIXBIT	\NOWAIT\
	SIXBIT	\FAST\
	SIXBIT	\LONG\
	SIXBIT	\DEITY\
	SIXBIT	\TITLES\
	SIXBIT	\ECHO\
	SIXBIT	\NOECHO\
	SIXBIT	\LF\
	SIXBIT	\NOLF\
	SIXBIT	\ABSOLU\

SWTLST:	SWTNAM-.,,SWTNAM

;TABLE OF THINGS TO DO ON A SWITCH
SWTXCT:	TXOA	F,ALLSWT	;/ALL
	TXOA	F,INPSWT	;/INPUT
	TXOA	F,OUTSWT	;/OUTPUT
	JRST	SLFSET		;/SELF
	JRST	SLOSET		;/SLOW
	TXOA	F,NWTSWT	;/NOWAIT
	JRST	FSTSET		;/FAST
	TXOA	F,LNGSWT	;/LONG
	TXOA	F,GODSWT	;/DEITY
	TXOA	F,TTLSWT	;/TITLES
	TXOA	F,ECHSWT	;/ECHO
	TXOA	F,NECSWT	;/NOECHO
	TXOA	F,LFSWT		;/LF
	TXOA	F,NLFSWT	;/NOLF
	TXOA	F,ABSSWT	;/ABSOLUTE

SLFSET:	MOVEI	T4,JOBNAM-PARNAM
	JRST	PVAL1

FSTSET:	MOVEI	T1,2		;/FAST, SET CODE 2
	TXOA	F,FSTSWT	;ALSO SET FLAG
SLOSET:	MOVEI	T1,5		;128 SEC = SLOW

WATSET:	DPB	T1,PWATCD
	RETURN
SUBTTL SUBROUTINES

; count each character and count it
CntOut:	aos	ChrCnt		; keep count of characters
	OutChr	U1		; and output this one
	Return			; return!


; space to a particular column.  assumes T1 is pushed on the stack.
TabIt:	Camg	T1,ChrCnt	; are we there yet?
	  Jrst	TPopj		; get T1 back and return
	Wchi	" "		; space to column
	jrst	TabIt		; and loop

Tpopj:	pop	p,T1		; restore T1
	Return			; and return.


; routine to read a character, and ignore it if it's ignorable.
; also sets the break flag if it's a break char.
FScan:	Call	Save2##		; save some regs
FScan1:	inchwl	P1		; get the character
	RFLG	P1		;GET FLAGS
	TXNE	P2,IGNOR	;CONTROL CHAR?
	  JRST	FSCAN1		;YES, IGNORE
	TXNE	P2,BREAK	;BREAK?
	TXO	F,BRKFLG	;YES
	Move	U1,P1		; put char where it'll be found
	RETURN

;SUBROUTINE TO FLUSH THE REST OF THE LINE
FLUSH1:	RChf	P2		;GET ANOTHER CHARACTER
FLUSH:	TXNN	P3,BREAK	;BREAK?
	JRST	Flush1		;NO
	TXZ	F,BRKFLG	;YES,  AND START OVER
	RETURN			;RETURN
;SUBROUTINE TO GET THE NEXT TEXT FIELD
GETSYM:	Hrlzi	T1,Label		; make entry to RdCmd at LABEL
	JRST	TEXTIN

;SUBROUTINE TO GET THE NEXT FIELD
FIELDN:	Hrlzi	T1,Field		; enter RdCmd at FIELD
	Jrst	Textin

;SUBROUTINE TO GET THE ENTIRE LINE
LISTIN:	Hrlzi	T1,LIST		; enter RdCmd at LIST
TextIn:	Hrri	T1,RdCmd	; the production table is RdCmd
	PJrst	LexInt##	; go produce.


;HERE WHEN DONE
TSTOP:	JUMPG	P2,STOP
TSTOP1:	EDisix	[STOP,,[SIXBIT \? S&OCKET NOT FOUND#!\]]

; here if we got a table error.  SixScr sets T1<0 if ambiguous,
; table description is pointer to by T2.  SixSrc returns the object
; it was searching for in T3.
TabDcd:	move	T1,1+[			; decide which brand of failure
			[Sixbit \&an ambiguous!\]	; T1=-1
			[Sixbit \¬ a recognized!\]	; T1= 0
		      ](T1)
	EDisix	[Stop1A,,[Sixbit \&? ""%"" is % %.#!\]
		 WName	T3			; give object of search
		 Wsix	(T1)			; which type
		 Wsix	(T2)			; description
		]

; here if we can't trust P3
Stop1A:	Txnn	f,BrkFlg	; end of line yet?
	  call	Flush1		; no: swallow line
	jrst	Stop1		; and to the normal stuff

;HERE ON SOME SPECIFICATION ERRORS
SKTER:	WSIX	[SIXBIT \&SOCKET!\]
SPECER:	WSIX	[SIXBIT \& SPECIFICATION ERROR#!\]


;HERE WHEN ALL THROUGH
STOP:	TXNN	F,BRKFLG	;END OF LINE?
	CALL	FLUSH		;NOT YET
STOP1:	SKPINL			;SUPPRESS EFFECT OF CONTROL-O
	  JFCL
	TXNE	F,RUNFLG	;RUN COMMAND?
	JRST	STOP3		;YES
	TXNE	F,LOGFLG	;NO, JOB LOGGED IN?
	JRST	STOP2		;YES
	WSIX	[SIXBIT\#.!\]	;NO, HAVE TO TYPE OUR OWN PERIOD
	LOGOUT			;AND LOG OURSELF OUT
STOP2:	RESET			;ENSURE ALL FILES CLOSED
	EXIT	1,		;SILENT EXIT
STOP3:	SETZM	OFile##		;YES.  OR CONTINUE
ifn FtKSeg,<	;drp	need to undo meddle if we getsegged
	Skipn	LowHTS##	;HAS THE HOST TABLE BEEN SETUP?
	SKIPN	THSHST		;NO, WAS IT BECAUSE HISEG DISAPPEARED
				;  WHILE WE WERE TELNETTING?
> ;drp	end of ifn FtKSeg
	JRST	IMPCO1		;JUST RESTART
ifn FtKSeg,<	;drp	must rerun, since we have meddle bit set
	MOVEI	T1,RUNDEV	;YES, DO A RUN INSTEAD OF RESTARTING
	RUN	T1,		;  BECAUSE OTHERWISE WE WON'T BE ABLE TO
	  HALT			;  REBUILD THE HOST TABLE BECAUSE WE
				;  DID A GETSEG AND THAT'S MEDDLING.
> ;drp	end of ifn FtKSeg
CMDERM:	SIXBIT \? C&OMMAND ERROR#!\
SWTERM:	SIXBIT \? S&WITCH ERROR#!\
BADSWT:	Sixbit \? I&NAPPROPRIATE SWITCH SEEN#!\	;[96bit]
ARGERM:	SIXBIT \? E&XPLICIT ARGUMENT REQUIRED#!\


;SUBROUTINE TO TYPE THE STATUS OF THE CONNECTION BLOCK
;  WHOSE ADDRESS IS IN P1.  ENTER WITH PHYSICAL NAME IN T1.

TYPSTS:	TXOE	F,TITLTY	;TITLE ALREADY TYPED?
	JRST	TYPST0		;YES, PROCEED
	TXNN	F,<FSTSWT!LCLFLG!DEVFLG> ;/FAST OR EXPLICIT ARG?
	TXC	F,TTLSWT	;NO, COMPLEMENT /TITLE SWITCH
	TXNN	F,TTLSWT	;TITLE TO BE TYPED?
	JRST	TYPST0		;NO
	TXNN	F,FSTSWT	;SKIP IF /FAST
	WSIX	[SIXBIT\IMP  L&OGICAL &J&OB   &L&OCAL-&P&ort &S&TATE  &F&OREIGN-&H&OST   &F&OREIGN-&P&ort &TTY#!\]
	TXNE	F,FSTSWT	;SKIP IF NOT /FAST
	WSIX	[SIXBIT\IMP  L&OGICAL &J&OB &S&TATE  &F&OREIGN-&H&OST   &TTY#!\]
	TXNE	F,LNGSWT	;EXTENDED STATUS
	WSIX	[SIXBIT\      P&rt   &R&'cv-wnd    &S&end-wnd     &R&etran#!\]
;CONTINUE TYPSTS
TYPST0:	Clearm	ChrCnt		; set to column 0
	MOVSI	T2,(A)		;PUT SIXBIT DEVICE NUMBER IN LH
	TLNN	T2,77		;RIGHT-JUSTIFY
	LSH	T2,-6
	TLNN	T2,77
	LSH	T2,-6
	WSIX	3,T2		;PRINT IMP NUMBER
	WTAB	5		;LINE UP
	CAMN	A,.IBDEV(P1)	;ANY LOGICAL NAME ASSIGNED?
	JRST	.+3		;NO
	WNAME	.IBDEV(P1)	;YES, PRINT IT
	WCHI	":"		;AND A COLON
	WTAB	↑D13		;LINE UP AGAIN
	HLRZ	T2,.IBSTT(P1)	;GET JOB#
	WDECI	3,(T2)		;PRINT IT
	WCHI	" "
	hrrz	T4,.IBSTT(P1)	;GET STATE
	TXNE	F,FSTSWT	;/FAST?
	JRST	TYPST1		;YES, OMIT LOCAL SOCKET
	JUMPE	T4,.+2		;OMIT ALSO IF THIS SIDE CLOSED
	WOCT	↑D11,.IBLCL(P1)	;PRINT LOCAL SOCKET NUMBER
	WTAB	↑D30		;LINE UP AGAIN
TYPST1:	WSIX	6,STATES(T4)	;PRINT STATE
	JUMPE	T4,TCrLf	;DONE IF CLOSED STATE
;[tcp]	HLRZ	T2,.IBBYT(P1)	;GET BYTE SIZE
;[tcp]	TXNN	F,FSTSWT	;/FAST?
;[tcp]	WDECI	4,(T2)		;NO, PRINT BYTE SIZE
	WCHI	" "
;[96bit]HRRZ	T1,.IBHST(P1)	;GET HOST NUMBER
	MOVE	T1,.IBHST(P1)	;GET HOST NUMBER
	PUSHJ	P,TYPHSN	;TYPE HOST NAME FOR THAT NUMBER
	WTAB	↑D37		;ADVANCE TO NEXT FIELD
	TXNE	F,FSTSWT	;/FAST?
	JRST	TYPST2		;YES
	WTAB	↑D50		;NO, CORRECT ADVANCE
	WOCT	↑D13,.IBRMT(P1)	;TYPE REMOTE SOCKET #
TYPST2:	Move	T1,A		; get device into T1
	ITTY	T1		;GET CROSSPATCHED OR CONTROLLED TTY
	  JRST	TCrLf		;OMIT IF ERROR RETURN
	JUMPGE	T2,TYPST3	;JUMP IF LOCAL TTY CROSSPATCHED
	WOCTI	5,(T2)		;ELSE IS REMOTE TTY LINE (ITY)
	JRST	TCrLf		;DONE
TYPST3:	HRRZS	T2		;CLEAR JUNK IN LH
	GETLCH	T2		;RETURN LINE CHARACTERISTICS
	TXZ	T2,.UxTrm	; zap the terminal bit
	TXNN	T2,Gl.Cty		;IS IT THE CTY?
	Disix	[Cpopj,,[SIXBIT\  *%#!\] ;NO
		WOCTI	(T2)]
	WSIX	[SIXBIT\  *CTY!\] ;YES
	PJrst	TCrLf		; finish line and return
;SUBROUTINE TO TYPE OUT BOTH HOST NAME AND NICKNAME, IF A NICKNAME
;   EXISTS, GIVEN HOST NUMBER IN T1.

TypHst:	Push	p,T1		; save host number in case fails
	Movei	T2,TypNam	; go here when found host
	Movei	T3,GotNck	; here for each nick name
	Seto	T4,		; look for exact match
	hrrm	T4,ChrCnt	; put large number into chrcnt so no tab
	Txz	F,NckNam	; remember no nicknames printed yet
	Pushj	P,HstNGn	; do it
	  Jfcl			; couldn't get the table
	  Jrst	TypHs2		; and type the number (not found)
	Call	NckCln		; clean up leftover nickname, add CRLF
	Jrst	TPopj		; clear stack and return


;SUBROUTINE TO TYPE OUT THE NAME OF THE HOST WHOSE NUMBER IS GIVEN IN T1

TypHsn:	Push	p,T1		; save the host number for failure
	Pushj	P,HstNum##	; find the name
	  Jfcl			; lost
	  Jrst	TypHs3		; host not there: type number
	Pop	P,T2		; clean up the stack
TypNam:	Wasc	(T1)		; output the host name
	Return			; clear stack and return

;HERE IF HOST NOT IN TABLES, OR TABLES UNAVAILABLE
TypHs2:	Pop	P,T1			; get back the host number
	Call	TypHs4			; type the host number
	PJrst	TCrLf			; give a crlf and return

; get back the host number, and tell we're faking it.
TYPHS3:	Pop	P,T1			; restore host number
TypHs4:	WSix	[Sixbit \H&ost !\]	;[96bit] output host

; routine to print a host number as <host>.<Site>
TypHNm:	lsh	t1,4			; left justitfy it
	skipa	t4,[4]			; four bytes in a host number (and
					;  skip into loop.
TypHNL:	  wchi	"."			; separator
	setz	t2,			; clear out target
	rotc	t1,↑d8			; get next byte of host number
	wdec	t2			; print it
	sojg	t4,TypHNL		; loop until happy
	return				; go home
;SUBROUTINE TO SET UP AN ICP CONNECTION
;CALL:
;	MOVE	P1,[ADDRESS OF 2 CONNECTION BLOCKS]
;	MOVE	T1,[TARGET REMOTE ICP SOCKET NUMBER]
;	CALL	ICPGET
;	  ERROR RETURN	...  MESSAGE TYPED.  NO CONNECTION.
;	OK RETURN  ...	CONNECTION SET UP
ICPGET:
repeat 0,<	;[tcp] much simpler in TCP
	TRNN	T1,1		;REMOTE SOCKET BETTER BE ODD
	  IDIOT
	MOVEM	T1,ICPBLK+.IBRMT
	MOVE	T1,.IBHST(P1)	;HOST
;[96bit]HRRM	T1,ICPBLK+.IBHST
	MOVEM	T1,ICPBLK+.IBHST		;[96bit]
	MOVEM	T1,.IBHST+.IBSIZ(P1)
	MOVE	T1,.IbByt(P1)		;[96bit] get byte size
	MOVEM	T1,.IbByt+.IbSiz(P1)	;[96bit] and store.
	MOVE	T1,.IBLCL(P1)	;LOCAL INPUT SOCKET
	CAIG	T1,↑O777
	CAIGE	T1,2
	  IDIOT
	TRNE	T1,1
	  IDIOT
	SUBI	T1,2
	MOVEM	T1,ICPBLK+.IBLCL	;INITIAL LOCAL SOCKET
	ADDI	T1,3
	MOVEM	T1,.IBLCL+.IBSIZ(P1) ;LOCAL OUTPUT SOCKET
	SETZM	.IBRMT(P1)	;CLEAR REMOTE SOCKET FIELDS FOR LISTEN
	SETZM	.IBRMT+.IBSIZ(P1)
	Listen	.IBDEV(P1)	;LISTEN ON BOTH SOCKETS
	  IMPERR Cpopj##
	MOVE	T1,.IBDEV(P1)	;TRANSFER ALLOCATED DEVICE NAME IF NECESSARY
	MOVEM	T1,.IBDEV+.IBSIZ(P1)
	Listen	.IBDEV+.IBSIZ(P1)
	  IMPERR ICPGE9
;CONTINUATION OF THE ICP CODE
ICPGE1:	CONN	ICPBLK		;CONNECT
	  IMPERR ICPGE6
	FSETUP	FILICP
	FiGet	ImpFil		; open IPC:
	MOVSI	T1,(POINT 32)	;SET ICP BYTE SIZE
	HLLM	T1,ImpFil+FILPTR
	RCH	T2		;GET THE 32-BIT SOCKET NUMBER
	FRel	ImpFil		;CLOSE OUT THE ICP DATA CONNECTION
	SETZM	IFile##		;CLEAR INPUT FILE POINTER
	CLOS	ICPBLK
	  IMPERR .+1
	CLOS	1,ICPBLK	;JUST IN CASE
	  JFCL
	TLO	T2,(1B0)		;IN CASE ITS 0
	TRO	T2,1
	MOVEM	T2,.IBRMT(P1)
	TRZ	T2,1		;MUST BE EVEN
	MOVEM	T2,.IBRMT+.IBSIZ(P1)
> ; end of repeat 0
;STILL MORE ICP CODE
	CONN	.IBDEV(P1)	;CONNECT
	  IMPERR ICPGE8
;[tcp]	CONN	.IBDEV+.IBSIZ(P1)
;[tcp]	  IMPERR ICPGE8
	JRST	Cpopj1##		;SKIP RETURN

repeat 0,<	;[tcp]
;VARIOUS ENTRIES FOR VARIOUS LEVELS OF ERROR RECOVERY

ICPGER:	ERRIN	ImpFil		;INPUT ERROR READING ICP FILE
ICPGE5:	FRel	ImpFil		;CLEAN UP ICP DEVICE
ICPGE6:	CLOS	1,ICPBLK
	  JFCL
	CLOS	1,ICPBLK
	  JFCL
ICPGE8:	CLOS	1,.IBDEV+.IBSIZ(P1) ;CLOSE OUT OUTPUT THEN INPUT SIDE
	  JFCL
	CLOS	1,.IBDEV+.IBSIZ(P1)
	  JFCL
> ;[tcp]
ICPGE8:
ICPGE9:	CLOS	1,.IBDEV(P1)	;CLOSE OUT INPUT SIDE
	  JFCL
	CLOS	1,.IBDEV(P1)
	  JFCL
	SETZM	IFile##		;JUST IN CASE
	RETURN			;AND TAKE NON-SKIP RETURN
;SUBROUTINE TO MATCH EACH IMP IN THE SYSTEM WITH THE COMMAND
;  SPECIFICATIONS.  FOR EACH ONE THAT MATCHES,  CALL THE ROUTINE
;  WHOSE ADDRES WAS SPECIFIED IN A.
ALLIMP:	SAVE 	A
;[tcp]	TXZ	F,ODDFLG
	SETZB	A,FRESKT	;LOWEST IMP NUMBER TO START
	SETZM	FRESKT+1	;CLEAR SOCKET USE MAP
ALLIM1:	SETZM	.IBLCL+STTBLK
	TXZ	F,DUPLEX	;CLEAR DUPLEX CONNECTION FLAG
	PUSH	P,A		;SAVE CURRENT IMP NUMBER
ALLIM2:	PUSHJ	P,IMPSIX	;CONVERT TO SIXBIT NAME
	MOVEM	A,.IBDEV+STTBLK	;PHYSICAL NAME
	STAT	STTBLK		;GET STATUS
	  JRST	ALLIM5		;THIS ONE LOSES
	CALL	STATST		;TEST IT
	  JRST	ALLIM3		;NO MATCH
	CALL	@-1(P)		;CALL THE SUBROUTINE
	  JRST	ALLIM3		;NOW GO FOR NEXT
	RESTORE	A
	JRST	ALLIM6		;EXIT ON SKIP RETURN FROM SUBROUTINE

ALLIM3:	MOVE	A,(P)		;GET BACK IMP NUMBER
;[tcp]	TXCE	F,ODDFLG	;COMPLEMENT ODD FLAG, WAS IT ON?
;[tcp]	JRST	ALLIM5		;YES
;[tcp]	SETOM	.IBLCL+STTBLK	;NO, IT IS NOW
;[tcp]	JRST	ALLIM2

ALLIM5:	POP	P,A		;RESTORE IMP NUMBER
	CAMGE	A,IMPNUM	;COMPARE TO NUMBER OF IMPS IN SYSTEM
	AOJA	A,ALLIM1	;GO DO SOME MORE
ALLIM6:	RESTORE	A
	RETURN


;SET UP DEFAULTS
SETME:	SETZM	COMBLK		;CLEAR COMMAND BLOCK
	MOVE	T1,[COMBLK,,COMBLK+1]
	BLT	T1,COMBLK+.IBSIZ-1
	HRRZ	T1,JOBN		;JOB NUMBER
	HRLM	T1, .IBSTT+COMBLK
	SETZM	WAITCD##		;DEFAULT ON WAIT CODE
	RETURN

STATST:	Move	T1,A			; position arg
	MOVE	T2,.IBLCL+STTBLK	;GET LOCAL SOCKET NUMBER
	IDIVI	T2,400		;SEPARATE OUT USER-SPECIFIED PART
	ROT	T2,-1		;PUT JOB SPECIFIER IN LH
	HRRZ	T4,PRJPRG	;GET OUR USER #
	CAME	T2,T4		;IS IT ONE OF OUR SOCKETS?
	JRST	STATS0		;NO
	LSH	T3,-2		;YES, DIVIDE USER PART OF SOCKET BY 4
	MOVN	T2,T3		;NEGATE
	MOVSI	T3,400000	;BIT TO SET USE MAP WITH
	SETZ	T4,		;IT'S 64 BITS LONG (SINCE 256 SOCKETS)
	LSHC	T3,(T2)		;POSITION SOCKET BLOCK # BITS FROM LEFT
	IORM	T3,FRESKT	;MARK 4-WORD SOCKET BLOCK IN USE
	IORM	T4,FRESKT+1
STATS0:	TXNE	F,DEVFLG	;DEVICE SPECIFIED?
	CAMN	T1,.IBDEV+COMBLK	;YES, IS THIS THE ONE?
	JRST	STATS1		;YES OR NOT NEEDED
	MOVE	T1,.IBDEV+STTBLK	;NO MATCH, TRY LOGICAL NAME
	CAME	T1,.IBDEV+COMBLK	;SAME?
	POPJ	P,		;NO, NO MATCH
STATS1:
;[tcp]	MOVE	T1,.IBLCL+STTBLK	;FETCH LOCAL SOCKET NUMBER
;[tcp]	ANDI	T1,1		;REMEMBER SEX ONLY
;[tcp]	XCT	[TXNE	F,OUTSWT ;IF INPUT SOCKET AND /OUTPUT
;[tcp]		 TXNE	F,INPSWT](T1) ;OR OUTPUT SOCKET AND /INPUT
;[tcp]	POPJ	P,		;  THEN NO MATCH
;[96bit]MOVE	T1,.IBHST+STTBLK	;OK, GET BYTE SIZE,,HOST
;[96bit]XOR	T1,.IBHST+COMBLK	;COMPARE TO SUPPLIED PARAMETERS
;[96bit]TRNN	F,BYTFLG	;BYTE SIZE SPECIFIED?
;[96bit]TLZ	T1,-1		;NO, DON'T CHECK BYTE SIZE
;[96bit]TDNN	F,[SITSWT+HSTFLG] ;HOST SPECIFIED?
;[96bit]TRZ	T1,-1		;NO, DON'T CHECK HOST
;[96bit]TLNE	F,(SITSWT)	;ONLY SITE GIVEN?
;[96bit]TRZ	T1,777700	;YES, DON'T CARE WHICH HOST AT SITE
;[96bit]JUMPN	T1,CPOPJ		;JUMP IF SUPPLIED PARAMETERS DON'T MATCH
	TXNN	F,<SITSWT!HSTFLG> ;[96bit] HOST SPECIFIED?
	  JRST	Stats2		;[96bit] no: don't check it.
	MOVE	T1,.IBHST+STTBLK	;[96bit] OK, GET HOST
	XOR	T1,.IBHST+COMBLK	;[96bit] COMPARE TO SUPPLIED PARAMETERS
	TXNE	F,SITSWT	;[96bit] ONLY SITE GIVEN?
	  TXZ	T1,Ih.Hst	;[96bit] YES, mask out host number.
	JUMPN	T1,CPOPJ		;[96bit] JUMP if address doesn't match
Stats2:
;[tcp]	TXNN	F,BYTFLG	;[96bit] BYTE SIZE SPECIFIED?
;[tcp]	  JRST	Stats3		;[96bit] no: don't check
;[tcp]	MOVE	T1,.IbByt+SttBlk	;[96bit] get byte size
;[tcp]	CAME	T1,.IbByt+ComBlk	;[96bit] does it match?
;[tcp]	  POPJ	P,		;[96bit] no: no match
Stats3:				;[96bit]
	MOVE	T1,.IBSTT+STTBLK	;GET JOB#,,STATE
	XOR	T1,.IBSTT+COMBLK	;COMPARE TO PARAMETERS SUPPLIED
	TRZ	T1,777700	;MASK OUT JUNK
	TXNN	F,<SLFSWT!JOBFLG> ;/JOB:N OR /SELF? -- HVZ-4/23/75
	TLZ	T1,-1		;NO, DON'T CHECK JOB
	TXNN	F,STTFLG	;STATE SPECIFIED?
	TRZ	T1,-1		;NO, DON'T CHECK STATE
	JUMPN	T1,CPOPJ		;RETURN IF SUPPLIED PARAMETERS DON'T MATCH
;CONTINUATION OF PARAMETER CHECKING
	MOVE	T1,.IBRMT+STTBLK	;FETCH REMOTE SOCKET NUMBER
	XOR	T1,.IBRMT+COMBLK	;COMPARE TO USER PARAMETER
	TXNE	F,RMTFLG	;REMOTE SOCKET SPECIFIED?
	JUMPN	T1,CPOPJ		;YES, RETURN IF THEY DON'T MATCH
	MOVE	T1,.IBLCL+STTBLK	;FETCH LOCAL SOCKET NUMBER
	MOVE	T2,.IBLCL+COMBLK	;FETCH PARAMETER SUPPLIED BY USER
	XOR	T1,T2		;COMPARE
	CAIG	T2,777		;FULL SOCKET SPECIFIED?
	ANDI	T1,777		;NO, IGNORE OWNER STUFF
	TXNE	F,USRFLG	;/USER?
	TRZ	T1,377		;YES, DON'T CARE WHICH OF HIS SOCKETS
	TXNE	F,<USRFLG!LCLFLG>	;/LOCAL OR /USER?
	JUMPN	T1,CPOPJ		;YES, JUMP IF PARAMETERS DON'T MATCH
	HLRZ	T1,.IBSTT+STTBLK	;GET REAL OWNER OF IMP DEVICE
	TXNN	F,<ALLSWT!SLFSWT!DEVFLG!JOBFLG!USRFLG!RMTFLG> ;DO WE CARE?
	CAMN	T1,JOBN		;YES, SEE IF WE OWN IT
	JRST	Cpopj1##		;WE OWN IT OR DON'T CARE
	POPJ	P,		;NOT THIS ONE


;SUBROUTINE TO MANUFACTURE THE NAME SIXBIT\IMPN\ OUT OF THE NUMBER
;   GIVEN IN A, AND RETURN IT IN A.  Clobbers B.

IMPSIX:	SETZ	B,		;INIT RESULT
IMPSX1:	LSHC	A,-3		;SHIFT OFF A DIGIT
	LSH	B,-3		;SIXBITIZE IT
	TXO	B,<<'0'>B5>
	JUMPN	A,IMPSX1	;BACK IF MORE DIGITS
	HLRZ	A,B		;PUT RESULT IN RH
	HRLI	A,'IMP'		;'IMP' IN LH
	POPJ	P,
;ROUTINE TO SEARCH FOR A GIVEN SIXBIT NAME IN A NAME TABLE, WITH ANY
;UNIQUE ABBREVIATIONS ALLOWED.
;ARGS:	T1	SIXBIT NAME OR ABBREVIATION TO BE SEARCHED FOR
;	T2	XWD -<LENGTH OF TABLE>,<ADR OF TABLE>
;THE NON-SKIP RETURN IS TAKEN IF THERE IS NO EXACT OR UNIQUE MATCH.
;T1 WILL BE ZERO IF THERE WAS NO MATCH, AND -1 IF THERE WAS
;AN AMBIGUOUS ABBREVIATION.
;THE SKIP RETURN IS TAKEN IF EITHER THE NAME EXACTLY MATCHES AN ENTRY IN THE
;TABLE OR THE ABBREVIATION MATCHES EXACTLY ONE ENTRY.  THE INDEX OF THE
;MATCHING ENTRY (RELATIVE TO THE START OF THE TABLE) IS RETURNED IN T1.
;IF DUPLICATE ENTRIES APPEAR IN THE TABLE, they will be ambiguous

; Enter at SixSrA with argument in A.  A is not disturbed.

;AC'S CLOBBERED:  T1,T2,T3,T4
; (T3 returns argument)

;AC usage:	T1	current offset into table  (first entry is 1)
;			(correct by decrementing when returning)
;		T2	IOWD pointer to entry in table currently
;			being considered.
;		T3	entry we're looking for.  (T1 parameter)
;		T4	Sixbit of current entry.  (for hacking upon)
;		P1	Offset of partial match, or 0 if none yet,
;			or -1 if ambiguous entries have been seen
;		P2	mask for removing unwanted bits from a guess

SixSrA:	Skipa	T3,A		; entry to search for entry in A
SixSrc:	Move	T3,T1		; save the entry
	Call	Save2##		; get a couple more ACs
	Setzb	T1,P1		; clear offset count and partial match

; first, figure out the mask for the characters actually present.
	Seto	P2,		; start the Mask as all ones
SixSr1:	Tdnn	T3,P2		; is this in free space yet?
	  Jrst	SixSr2		; yes: go scan the table
	Lsh	P2,-6		; no: shift it down a character
	Jrst	SixSr1		; and loop.

; now scan the table for the entry
SixSr2:	aos	T1		; increment offset.  (can't be zero)
	Move	T4,(T2)		; get the next table entry
	Camn	T4,T3		; is this it?
	  Soja	T1,Cpopj1##	; yes: complete success.  return T1

	Tdz	T4,P2		; no: clear chars that aren't there
	Came	T4,T3		; better?
	  Jrst	SixSr3		; no: go loop

	; partial match found.
	Skipn	P1		; have we seen anything before?
	 Skipa	P1,T1		; no: save this one as partial match
	  Seto	P1,		; yes: flag ambiguous entries seen

SixSr3:	Aobjn	T2,SixSr2	; increment table entry and loop.

	; table exhausted: see if there's anything intelligent
	Skipg	T1,P1		; is there an offset?
	  popj	p,		; no: error return, T1 set
	Soja	T1,Cpopj1##	; yes: found something.  return happy,
				; and make T1 real offset.
;SUBROUTINE TO TYPE THE TABLE POINTED TO BY T2.
TYPLST:	HLLZ	T1,T2		;COPY COUNT, ZERO INDEX
	HRLI	T2,T1		;PREPARE TO INDIRECT/INDEX
TYPLS0:	TRNN	T1,7		;FINISHED A ROW?
	W2CHI	CRLF		;YES, START ANOTHER
	WNAME	@T2		;TYPE AN ENTRY
	WCHI	TAB		;TAB
	AOBJN	T1,TYPLS0	;LOOP IF MORE
	WSIX	[SIXBIT\##!\]	;ADVANCE
	POPJ	P,
	;DATE ROUTINE
;OUTPUT DATE ONTO CURRENT OUTPUT FILE, IN FORM DD-MMM-YY.
;CALL AT ADATE:  ARG IN ACCUMULATOR T1 (IN 12-BIT FORM ((Y-64)*12+M-1)*31+D-1).
;CALL AT TDATE:  NO ARG - OUTPUT TODAY'S DATE.

;AC'S CLOBBERED:  T1,T2

TDATE:	DATE	T1,		;GET TODAY'S DATE FROM MONITOR
	W2CHI	"  "		;OUTPUT TWO SPACES
ADATE:	IDIVI	T1,↑D31		;EXTRACT DAY-1
	WDECI	2,1(T2)		;OUTPUT DAY IN 2-CHARACTER FIELD
	IDIVI	T1,↑D12		;SEPARATE MONTH AND YEAR
	CAIGE	T2,6		;WHICH HALF OF YEAR?
	SKIPA	T2,MONTAB(T2)	;FIRST HALF.  USE LEFT HALF OF ENTRY
	MOVS	T2,MONTAB-6(T2)	;SECOND HALF.  USE RIGHT HALF OF ENTRY
	WCHI	"-"
	WSIX	3,T2		;MONTH
	WCHI	"-"
	WDECI	2,↑D64(T1)	;YESR
	RETURN

MONTAB:	SIXBIT	/JANJUL/
	SIXBIT	/FEBAUG/
	SIXBIT	/MARSEP/
	SIXBIT	/APROCT/
	SIXBIT	/MAYNOV/
	SIXBIT	/JUNDEC/



	;TIME ROUTINE
;OUTPUT TIME ONTO CURRENT OUTPUT FILE, IN FORM HH:MM:SS.
;CALL AT JTIME WITH ARG IN ACCUMULATOR T1 (JIFFIES SINCE MIDNIGHT).
;CALL AT TTIME TO OUTPUT PRESENT TIME.

;AC'S CLOBBERED:  T1,T2
	W2CHI	"  "		;OUTPUT TWO SPACES
	JRST	MTIME		;GO OUTPUT ARG AS MINUTES

TTIME:	TIMER	T1,		;GET PRESENT TIME (JIFFIES SINCE MIDNIGHT)
JTIME:	IDIVI	T1,↑D60		;CONVERT JIFFIES TO SECONDS
MTIME:	PUSH	P,F		;SAVE PRESENT STATE OF FLAGS
	TXO	F,LZEFLG	;SET TO PRINT LEADING ZEROES
	IDIVI	T1,↑D3600	;SEPARATE HOURS AND MINUTES
	IDIVI	T2,↑D60		;GET OUT SECONDS
	Disix	[[SIXBIT\%:%:%!\] ;PRINT TIME
		WDEC	2,T1
		WDEC	2,T2
		WDEC	2,T3]
FPOPJ:	POP	P,F		;RESTORE STATE OF FLAGS
	RETURN
; file information.  the FSETUP uuo moves this information to their
; lowseg locations, where they are used.

; ICP information
;[tcp]	FILICP:	FILE	ICPCHN,I,ImpFil,<DEV(ICP),STATUS(6),EOF(ICPGER),INPUT(ICPGER)>

; telnet info
FILOTL:	FILE	OTLCHN,O,ImpFil,<DEV(TELNET),STATUS(2)>


; help file
FILHLP:	FILE	HLPCHN,I,HLPFIL,<DEV(HLP),NAME(IMPCOM),EXT(HLP)
		,OPEN(HLPER1),LOOKUP(HLPER2),INPUT(HLPER3),EOF(HLPER3)>
;CONNECTION BLOCKS, FILE BLOCKS, INITIAL PARAMETERS

	$low		;drp	to LOWSEG to get our bearings
Fill:			;drp	where we're going to put this data
	$high		;drp	back to HISEG to set up data
FillHi:			;drp	this is where the data will really be
	phase	Fill	;drp	but define symbols as if in the lowseg

;MACRO	NET	DEVICE,LOCAL,HOST,REMOTE,BYTESIZE

ICPBlk:	NET	ICP,,,,↑D32	;ICP CONNECTION BLOCK
TelBlk:
TelIBk:	NET	TELNET,2,,,↑D8
TelOBk:	NET	TELNET,3,,,↑D8

;PHASED LOW-SEGMENT CODE TO THROW AWAY THE HIGH SEGMENT AND DO THE
;   CROSSPATCH WAIT OPERATION.
ifn FtKSeg,<	;drp	routine to kill hiseg when crosspatched
XPWait:	PUSH	P,F		;SAVE FLAGS
	PUSH	P,P1		;SAVE POINTER TO TELNET CONNECTION BLOCK
	push	p,.JbSa		; save the start address
	MOVEM	P,SAVPDP	;SAVE P, SINCE AC'S ARE CLOBBERED BY GETSEG
	MOVSI	T1,1
	SKIPN	.JBDDT		;UNLESS DEBUGGING,
	CORE	T1,		;  ELIMINATE HISEG
	  JFCL			;HUH??
;[96bit]HRLI	P1,.IUXWT	;SETUP CROSSPATCH WAIT OPERATION CODE
	HRLI	P1,.IUXWT(If.New)	;[96bit] new format.
	MCALL	P1,LowUUO	;DO IT
	  INCHRW T2		;DO IT THE OLD WAY IF IT FAILS
	MOVEI	T1,RUNDEV	;POINT TO GETSEG COMMAND LIST
	SKIPE	.JBDDT		;IF DEBUGGING,
	JRST	.+3		;  DON'T DO TI
	GETSEG	T1,		;GET BACK IMPCOM HISEG
	  HALT			;LET THE MONITOR SAY WHAT HAPPENED
	MOVE	P,SAVPDP	;RESTORE P
	pop	p,.JbSa		; restore the start address
	POP	P,P1		;RESTORE P1
	POP	P,F		;RESTORE FLAGS
	POPJ	P,		;RETURN

; lowseg copy of sixbit ImpUUO, so we have one when no highseg
LowUUO:	SixBit	\ImpUUO\

;GETSEG COMMAND LIST (MODIFIED DURING INITIALIZATION)
RUNDEV:!SIXBIT	/SYS/
	SIXBIT	/IMPCOM/
	0
	0
RUNPPN:!0
	0
> ;drp	end of ifn FtKSeg

FilEnd==.-1			;drp	get last word's location
FilLen==.-Fill			;drp	get the length of the area
	DEPHASE

	$low			;drp	now to the LOWSEG to define area
	block	FilLen		;drp	allocate the space for data.
	$high			;drp	back to HISEG and normalacy

ife FtKSeg,<	;drp	normal hiseg method for going into IW
XPWait:	hrrz	t1,p1			;drp	get pointer to block
	HRLI	t1,.IUXWT(If.New)	;drp	wait for end of xpatch
	MCALL	t1,IMPUUO##		;drp	DO IT
	 INCHRW	T2			;drp	DO IT THE OLD WAY IF IT FAILS
	popj	p,			;drp	and return
> ;drp	end of ife FtKSeg
;AUXILIARY ROUTINES

;[96bit] routine to convert T1 from old format to new format.
HstCon:	CAIL	T1,↑D256		;[96bit] larger than old format?
	  RETURN		;[96bit] yep: must be new alreay
	LDB	T2,[Point 2,T1,35-6]	;[96bit] host number
	LSH	T2,↑D16			;[96bit] shift
	LDB	T1,[Point 6,T1,35]	;[96bit] get imp number
	IOR	T1,T2			;[96bit] mash them together
	RETURN				;[96bit] all converted
;IMP STATES	--	ONE WORD PER STATE
STATES:	SIXBIT	\CLOSED\
	SIXBIT	\LISTEN\
	sixbit	\SYNSnt\
	sixbit	\SYNRP\
	sixbit	\SYNRA\
	sixbit	\Establ\
	sixbit	\FIN1\
	sixbit	\FIN2\
	sixbit	\Clsing\
	sixbit	\TimWat\
	sixbit	\ClsWat\
	sixbit	\LstAck\

	NSTATE==:STATES-.
SUBTTL	COMMAND SCANNER

TblBeg	RdCmd		; productions to read the command line.

;ENTER HERE TO GET THE COMMAND
COMND:	PROD( <SG>		,CALL, ,TEXT	)
	PROD( <SG>		,ICHK, ,COMNM	)

;ENTER HERE TO GET THE COMMAND AFTER PROMPTING WITH '*'
COMNM:	PROD( <SG>		,CALL, ,TEXT	)
COMNM1:	PROD( <BLANK>		,    ,*,COMNM1	)
	PROD( SEMI		,CALL, ,FLUSHX	)
	PROD( -<BREAK>		,    ,←,COMNM2	)
COMNM2:	PROD( <SG>		,RET , ,	)

;ENTER HERE TO GET A PARAMETER FIELD WITHOUT REGARD TO SWITCHES,
;  DEVICE SPECIFIERS, ETC.
LABEL:	PROD( <SG>		,CALL, ,TEXT	)
LABEL1:	PROD( <BLANK>		,    ,*,LABEL1	)
	PROD( SEMI		,CALL, ,FLUSHX	)
LABEL2:	PROD( -<BLANK!DELIM!BREAK> , ,←,LABEL3	)
LABEL3:	PROD( <SG>		,RET , ,	)


;ENTER HERE TO GET THE ENTIRE COMMAND
LIST:	PROD( <SG>		,CALL, ,FIELD0	)
	PROD( <DELIM>		,    ,*,LIST	)
	PROD( -<BREAK>		,ECMD, ,	)
	PROD( <SG>		,RET , ,	)

;ENTER HERE TO GET THE NEXT FIELD
FIELD:	PROD( <BLANK>		,    ,*,FIELD	)
	PROD( -<BREAK!DELIM>	,CALL, ,FIELD0	)
	PROD( <BREAK!DELIM>	,RET , ,	)
	PROD( <SG>		,ECMD, ,	)
;SUBROUTINE TO GET A PARAMETER FIELD
FIELD0:	PROD( <SG>		,FINI, ,FIELD1	)
FIELD1:	PROD( <BLANK>		,    ,*,FIELD1	)
	PROD( LPAREN		,    ,*,LPARN	)
	PROD( "/"		,    ,*,SLASH	)
	PROD( <DELIM!BREAK>	,RET , ,	)
	PROD( <SG>		,CALL, ,TEXT	)
	PROD( ":"		,DSAV,*,FIELD1	)
	PROD( <EQUALS>		,ECMD, ,	)
	PROD( <SG>		,SHST, ,FIELD1	)

;HERE TO HANDLE SLASH (SWITCH)
SLASH:	PROD( <SG>		,CALL, ,SWITCH	)
	PROD( <SG>		,    , ,FIELD1	)

;HERE TO HANDLE LEFT PARENTHESES (SWITCHES)
LPARN:	PROD( <BLANK>		,    ,*,LPARN	)
	PROD( RPAREN		,    ,*,FIELD1	)
	PROD( <SG>		,CALL, ,SWITCH	)
	PROD( <DELIM>		,    ,*,LPARN	)
	PROD( -<BREAK>		,    , ,LPARN	)
	PROD( <SG>		,Ret , ,	)

;SUBROUTINE TO PROCESS A SWITCH
SWITCH:	PROD( <SG>		,CALL, ,TEXT1	)
	PROD( -<EQUALS>		,SSWT, ,SWIT2	)
	PROD( <SG>		,PSAV,*,SWIT1	)
SWIT1:	PROD( <SG>		,CALL, ,NAME	)
	PROD( <SG>		,PVAL, ,SWIT2	)
SWIT2:	PROD( <BLANK>		,    ,*,SWIT2	)
	PROD( <SG>		,RET , ,	)
;SUBROUTINE TO GET A TEXT OR NUMBER FIELD
NAME:	PROD( <SG>		,NINI, ,NAME1	)
NAME1:	PROD( <BLANK>		,    ,*,NAME1	)
NAME2:	PROD( <DELIM!BREAK>	,RET , ,	)
	PROD( <LETTER>		,    , ,TEXT1	)
	PROD( <SG>		,    , ,NUMB2	)

;SUBROUTINE TO GET A TEXT FIELD
TEXT:	PROD( <BLANK>		,    ,*,TEXT	)
TEXT1:	PROD( <SG>		,TINI, ,TEXT2	)
TEXT2:	PROD( "#"		,OINI,*,TEXT3	)  ;[96bit] to octal
TEXT3:	PROD( <LETTER!DIGIT>	,TPAK,*,TEXT3	)
	PROD( "-"		,TPAK,*,TEXT3	)  ;[96bit] or -?
	PROD( "."		,    ,*,HNUMB	)  ;[96bit] #.#?
	PROD( <SG>		,    , ,NUMB3	)


;[96bit] subroutine to complete parsing a host number: "#.#.#"
HNUMB:	PROD( <SG>		,CALL, ,NUMB	)  ;[96bit] get number
	PROD( "."		,HNPK,*,HNUMB	)  ;[96bit] put in place
	PROD( <SG>		,HNPK, ,NUMB3	)  ;[96bit] put in place

;SUBROUTINE TO GET A DECIMAL NUMBER
NUMB:	PROD( <SG>		,NINI, ,NUMB1	)
NUMB1:	PROD( <BLANK>		,    ,*,NUMB1	)
NUMB2:	PROD( "#"		,OINI,*,NUMB2	)
	PROD( <DIGIT>		,DPAK,*,NUMB2	)
NUMB3:	PROD( <BLANK>		,    ,*,NUMB3	)
	PROD( -SEMI		,RET , ,	)
FLUSHX:	PROD( -<BREAK>		,    ,*,FLUSHX	)
	PROD( <SG>		,RET , ,	)

;SUBROUTINE TO GET ARGUMENTS FOR THE ERROR COMMAND
ERRAR0:	PROD( <SG>		,CALL,*,SWITCH	)
ERRARG:	PROD( <BLANK>		,    ,*,ERRARG	)
	PROD( SEMI		,CALL, ,FLUSHX	)
	PROD( <BREAK>		,RET , ,	)
	PROD( "/"		,    , ,ERRAR0	)
	PROD( COMMA		,    ,*,ERRARG	)
	PROD( <SG>		,CALL, ,TEXT	)
	PROD( <SG>		,ESRC, ,ERRARG	)

	TblEnd	; end of RdCmd
SUBTTL	STORAGE

	$Low				; to low seg

ZERO==.			;CLEAR FROM HERE

RADIX:	BLOCK	1	;CURRENT TYPEIN RADIX
HstAdr:	BLOCK	1	;POSSIBLE HOST NUMBER DURING TEXT INPUT
COMBLK:	BLOCK	.IBSIZ	;FOR SAVING PARAMETERS ON COMMAND INPUT
STTBLK:	BLOCK	.IBSIZ	;FOR TAKING STATUS OF CONNECTION
PPARAM:	BLOCK	1	;FOR HOLDING PARAMETER POINTER DURING SPECS
CONFLG:	BLOCK	1	;FLAGS A CONTROL CHARACTER TO TELNET
PRJPRG:	BLOCK	1	;PROJECT,PROGRAMMER NUMBER
JOBN:	BLOCK	1	;JOB NUMBER
ChrCnt:	Block	1	; count of characters output on this line
ESCBLK:	BLOCK	4	;PARAMETERS FOR ESCAPES AND QUOTES
IMPNUM:	block	1	;NUMBER OF IMPS IN SYSTEM
HSTBLK:	BLOCK	.IBHST	;PARAMETER BLOCK FOR LHOST UUO
THSITE:	BLOCK	1	;LOCAL SITE PARAMETERS (PART OF HSTBLK BLOCK)
THSHST:	BLOCK	BufWds	;LOCAL HOST NAME IN SIXBIT
	LstHst==.-1	; last word of the host buffer
AscBuf:	Block	BufWds	; block for ascii text of command field,
			; in case it is a host name
	AscEnd==.-1	; last word of block
SYSVER:	BLOCK	1	;IMP SYSTEM VERSIONS (IMPSER,,NETCON)
XSTBLK:	BLOCK	.XSSIZ	;BLOCK FOR READING EXTENDED STATUS
FRESKT:	BLOCK	2	;LOACL SOCKET NUMBER USE MAP
WATIVL:	BLOCK	1	;WAIT INTERVAL FOR ERROR STATISTICS
LASTIM:	BLOCK	1	;TIME-OF-DAY OF MOST RECENT REPORT
GTTOLD:	BLOCK	1	;POINTER TO OLD STATISTICS TABLE
ErBits:	Block	1	; place to build up the bits for ERROR cmd.
XNMSAV:	BLOCK	1	;REMEMBERS GETTAB SUBTABLE POINTER FOR %ISXNM
ALLBTS:	BLOCK	1	;# OF BITS TO ALLOCATE ON TELNET COMMAND
ifn FtKSeg,<	;drp	needed if we do getsegs
SAVPDP:	BLOCK	1	;SAVES P OVER GETSEGS
> ;drp	end of FtKSeg

PDL:	BLOCK	PDLEN
ZEREND==.-1		;CLEAR TO HERE
; file blocks for hiseg blocks FilIcp, FilOTL, and FilHlp
ImpFil:	BLOCK	FBSIZE	; block used for ICP and TelNet control
HLPFIL:	BLOCK	FBSIZE	;FILE BLOCK FOR READING HELP MESSAGES

	$High			; back to high seg for literals
	END